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ABSTRACT 

Optimally scheduling a team of developers on a large software project is an NP- 
complete problem. The scheduling algorithm employed by the Evolutionary Control 
System (ECS) portion of the Computer-Aided Prototyping System (CAPS) does near- 
optimal scheduling using an algorithm that runs in Order N 2 space and time. The 
problem addressed by this thesis is to improve the performance of the algorithm and 
make it more useful for scheduling software developers. The thesis accomplished three 
things: (1) Modified the algorithm to run in order N time and space, preserving its 
near-optimal behavior; (2) implemented a calendaring package that computes federal 
holidays for any year after 1970 and schedules tasks only on non-holiday workdays; 
and (3) incorporated a more realistic capability model to better match programming 
tasks with each developer’s abilities. 
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I. 



BACKGROUND 



Much research into the formalization and automation of software development 
is underway. The need for such tools is obvious. It is fundamentally driven by Moore’s 
Law, which states that the power of computer systems will double every 18 months — 
a maxim which has held for the past twenty years, and is expected to continue for at 
least the next ten. As computer systems grow inexorably faster and more powerful, 
new software to take advantage of this increased power is needed. The new software, 
however, is larger, and more complicated, and now requires larger teams of developers 
to produce in a timely manner. Software tools to manage the complexity of developing 
these larger programs are needed. 

One such tool is the Evolutionary Control System (ECS) being developed at 
the Naval Postgraduate School (NPS). The basis of the ECS is Salah Badr’s Phd. 
Thesis, A Model and Algorithms for a Software Evolution Control System[ Ref. 1], 
which itself was based on work by Luqi[Ref. 4] of NPS. 

Salah’s thesis delved into a broad array of issues related to managing large 
projects and their concomitant complexity. One aspect of his thesis, which is the sub- 
ject of this report, was the development and implementation of an on-line scheduling 
algorithm that did three specific tasks: 

1. Supported teamwork by concurrently assigning ready steps to available de- 
signers. 

2. Supported incremental replanning as additional information became available. 

3. Minimized wasted design effort due to reorganization of the schedule by effi- 
ciently scheduling workers to assigned sub-tasks. 

Over time, however, certain limitations have become evident. The implemen- 
tation of the scheduling algorithm was found to be 0(N 2 ) in space. This led to a 
rapid exhaustion of memory resources on relatively small problem sets. Also, the 
model of time used to schedule the developers was not realistic. It assumed that the 
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developers were available always, and did not take into account weekends, holidays, 
or other commitments on a developer’s time. Also, the capabilities of the developers 
was split into just three broad categories: low, medium, and high. This too proved 
unrealistic, as certain developers bring their own strengths and weaknesses to the 
task at hand. It would be nice to take note, for instance, of a special ability such 
as database expertise, and assign a programmer with this capability to a task that 
require this knowledge. The changes made to Salah Badr’s codes do exactly this. 
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II. 



THE SCHEDULER 



The problem of optimally scheduling tasks for both the preemptive and nonpre- 
emptive cases is NP-complete[Ref. 6]. Scheduling nonpreemptive tasks with arbitrary 
ready times is also NP-complete in both multiprocessor and uniprocessor systems[Ref. 
3]. For dynamic systems with more than one task, and mutual exclusion constraints 
between tasks, Mok and Dertouzos[Ref. 5] showed that an optimal scheduling algo- 
rithm does not exist. 

Shiah, et al.[Ref. 2] came up with an heuristic scheduling algorithm that ran in 
order kN time. Salah Badr extended the algorithm to consider arbitrary precedence 
constraints between pairs of tasks. His scheduler forms the basis of the current ECS 
scheduling algorithm. 

The scheduling algorithm, as implemented by Badr, was recursive. It con- 
sumed order N 2 memory for a set of N tasks. It attempted to improve performance 
by limiting backtracking, but was still at least order N 2 in time. It was based on 
an algorithm described in the paper by Stankovic, et al.[Ref. 3] The requirement for 
order N 2 space limited the size of the problem domain. This thesis describes the 
algorithm and the steps taken to make the algorithm run using only order N space. 
It is based on the “myopic” algorithm [Ref. 2] and a radical restructuring of the data 
structures in the Ada code. 

A. THE SCHEDULING MODEL 

The task set in the ECS scheduling problem is a variable set of evolution 
steps S = {Si, S2, . . . , Sat}, where N varies with time. This set of tasks needs to be 
scheduled to a set of M designers D = {D\, D 2 , ■ ■ ■ , Dm}- The designers are of L 
different expertise levels. 

Tasks as used in the ECS are independent, nonperiodic and non-preemptive. 
They can be characterized by the following: 
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1 . Task arrival Time T 4 ; 

2. Task deadline Tp] 

3. Task worst-case computation time Tc\ 

4. Task expertise level Tp] 

5. Task priority Tp 

Each task also has associated with it a precedence constraint given in the form 
of a directed acyclic graph G = {5, E } such that (5,-, Sj) G E implies that Sj cannot 
start until S, has completed. 

The priority, Tp, is a small positive integer that is assigned to each task to 
reflect the criticality of its deadline. The priorites of different tasks should be com- 
patible with the precedence constraints between the steps, i.e. no lower priority step 
can precede a higher priority step: 

if ( 5 , 2 , 5 ' i ) € E =t> Tp(2) >= Tp(l) 
if (S 2 , Si) G E A T P (1) >= T P ( 3) => T P ( 2) >= T P (Z ) 

B. THE SCHEDULING ALGORITHM 

The goal of the scheduling algorithm is to determine if there exists a schedule 
for executing the tasks that satisfies the timing , precedence, and resource constraints, 
and to calculate such a schedule if it exists. A schedule that meets these constraints 
is termed feasible. It is not guaranteed to be optimal. 

Scheduling a set of tasks to find a full feasible schedule is actually a search 
problem. The search space is a tree. The scheduling algorithm starts at the root of 
the tree, and using a predetermined heuristic, selects a candidate task to schedule. If 
the remaining tasks can be added to the schedule, in the order given by the heuristic, 
without violating the constraints, then the partial schedule is termed strongly-feasible, 
and the task is added to the search tree as a vertex node, and the process is repeated, 
recursively, till a full, feasible schedule is found. If instead, after the candidate task is 
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selected, and any one of the remaining tasks added to the schedule violates the con- 
straints, the candidate task is rejected, and the next elgible, candidate task (ordered 
by the ranking function H(T)) is selected. The search process continues untill all the 
tasks are scheduled, or no feasible schedule is found. 

Instead of using all of the remaining tasks to determine if a partial schedule 
is strongly-feasible, Stankovic, et al.[Ref. 2], limited the candidate tasks to check 
to some number k. So, insteady of checking N, N — 1, . . . , 1 remaining tasks, or 
N(N — l)/2 total tasks, they limited the search to k or at most kN tasks to check. 

(This is where the term “myopic” comes in. Instead of looking at all the remaining 

tasks, we “near-sightedly” examine the next k tasks.) 

The set of tasks ready to be scheduled are ordered by the heuristic H(T). The 
candidate heuristics are 

1. Minimum deadline first (Min_D): H(T) = Tp; 

2. Minimum processing time first (Min_P): H(T ) = Tp] 

3. Minimum earliest start time first (Min_S): H(T) = T eat ; 

4. Minimum laxity first (Min_L): H(T ) = Tp — ( T est + Tp ); 

5. Min_D + Min_P: H{T) = T D + W x T P ; 

6. Min-D + Min_S: H(T) = T D + W x T e , t ; 

According to Shiah et al.[Ref. 3], The MinJD + Min_S heuristic is superior in all 
cases. It is supposedly used in Salah Badr’s dissertation, but since his simulation 
studies apparently used tasks with an earliest start time of 0 it defaults to Min_D. 
Min_D is used in the new implementation of the scheduling algorithm. 

C. ANALYSIS 

The scheduler as implemented by Salah Badr in Ada was Order N-squared 
in space. The heart of the code was a call on a search function performing a recur- 
sive search in tree-like fashion of potential schedules. In order to make the routine 
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Figure 1. Plot of scheduler run-time vs. number of tasks to schedule 

O(N) in space it was necessary to pull many of the large data structures out of the 
recursive routine, make them global, and manage changes with other global data 
structures. This necessarily complicated the code to a degree, but the result was an 
O(N) algorithm in space. 

Once the space problem was corrected, it became evident that the routine was 
also 0(N 2 ) in time. But this was easily rectified by using the “myopic” algorithm. 
Figure 1 shows the speed-up in processing speed vs. number of tasks to be scheduled 
for different versions of the code. The original data came with the original code. 
After the N 2 space problem was resolved, and before the myopic version of the code 
was added (first cut) we see that the code still runs in order N 2 time. The final cut 
shows the run-time for the final version of the code. 

The original data collected goes upto only 4600 tasks because the storage 
required was 0(N 2 ) in the number of tasks to be scheduled. A number larger than 
4600 tasks would cause the program to raise a storage-error exception. 




Tasks to Schedule 
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Figure 2. Plot of Laxity vs. percent schedules found 

D. SIMULATION 

To test the new scheduler routine, a routine to generate tasks that always have 
a feasible schedule was written. (Actually Badr had a routine to generate tasks, but 
it generated lists of tasks that were “easy” to schedule — that is the alogorithm never 
failed to find a schedule.) This routine varies the number of tasks, the number of 
programmers to use, and the “laxity” of the schedule generated. (Laxity is defined 
to be Td — (T eet + Tp).) It also uses the Ada ’95 random number generators to 
generate uniform distributions of random variables. The graph in Figure 2 shows 
the performance of the algorithm when 500 tasks per test case were generated, and 
the laxity was varied between zero and 0.7. As you can see, the algorithm failed 
miserably when there was zero laxity, and got progressively better as this constraint 
was “relaxed.” 
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III. 



CALENDAR 



The scheduling algorithm as originally implemented treated time continuously. 
Mapping this “continuous” time to calendar working time is a tedious task, especially 
as the number of tasks to schedule increases. Also, real dates give a better idea of 
the time-frames involved. 

The algorithm to translate a “continous” time to calendar time works as fol- 
lows: Consider the output of the scheduler in Table I for a simple set of 10 tasks. 

The first column is the task id, the second column is the expertise level required 
for the task (more on expertise levels, later), and the third column is the developer 
assigned to the task. (In this case we have three developers: LI, Ml, HI.) The second 
to last column is the start time and the last column is the end time in units of hours. 

After translating the start times and end times to calendar times we get the 
output in Table II For this data set the start date was set to July 3rd, 1997. The 
translator also assumed that the work day is eight hours. At NRaD the the work 
weeks are 5/4, i.e., 9 hours a day on Monday thru Thursday and 8 hours on Friday, 
with every other Friday off. Using -nrad as an input switch to the program, we get 
the new output shown in Table III. 

The dates in Table III start on the seventh of July because July 4th is a federal 
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HIGH 


HI 


0 


3 


2 


MEDIUM 


Ml 


0 


4 


1 


LOW 


LI 


0 


6 


4 


HIGH 


HI 


3 


13 


5 


MEDIUM 


Ml 


4 


12 


6 


LOW 


LI 


6 


10 


8 


MEDIUM 


Ml 


12 


14 


7 


LOW 


LI 


10 


15 


9 


HIGH 


HI 


13 


19 


10 


MEDIUM 


Ml 


14 


24 



Table I. Raw output of Scheduler 
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3 


HIGH 


HI 


07/03/1997+00 


07/03/1997+03 


2 


MEDIUM 


Ml 


07/03/1997+00 


07/03/1997+04 


1 


LOW 


LI 


07/03/1997+00 


07/03/1997+06 


4 


HIGH 


HI 


07/03/1997+03 


07/07/1997+05 


5 


MEDIUM 


Ml 


07/03/1997+04 


07/07/1997+04 


6 


LOW 


LI 


07/03/1997+06 


07/07/1997+02 


8 


MEDIUM 


Ml 


07/07/1997+04 


07/07/1997+06 


7 


LOW 


LI 


07/07/1997+02 


07/07/1997+07 


9 


HIGH 


HI 


07/07/1997+05 


07/08/1997+03 


10 


MEDIUM 


Ml 


07/07/1997+06 


07/08/1997+08 




Table II. Standard Work 


Day 


3 


HIGH 


HI 


07/07/1997+00 


07/07/1997+03 


2 


MEDIUM 


Ml 


07/07/1997+00 


07/07/1997+04 


1 


LOW 


LI 


07/07/1997+00 


07/07/1997+06 


4 


HIGH 


HI 


07/07/1997+03 


07/08/1997+05 


5 


MEDIUM 


Ml 


07/07/1997+04 


07/08/1997+04 


6 


LOW 


LI 


07/07/1997+06 


07/08/1997+02 


8 


MEDIUM 


Ml 


07/08/1997+04 


07/08/1997+06 


7 


LOW 


LI 


07/08/1997+02 


07/08/1997+07 


9 


HIGH 


HI 


07/08/1997+05 


07/09/1997+03 


10 


MEDIUM 


Ml 


07/08/1997+06 


07/09/1997+08 



Table III. NRaD Schedule 



holiday, and an NRaD off-Friday, this moves the off-Friday to the 3rd, so the first 
work-day is actually the seventh. It appears complicated, but the Ada implementation 
handles it quite easily. The format of MM/DD/YYYY+HR is used because daily schedules 
are idiosyncratic. The notation “+HH” means start or finish at that many hours into 
the workday. It should be easy to map this time format to any person’s particular 
schedule, but in the interest of time was not done here. 

The calendar package will also compute non-federal holidays such as Easter, 
election-day, and other useful dates. The present version runs in order N 2 time. It 
should be easy to convert to order N, but due to time constraints, this was not done 
during the course of this thesis. The calendar package was originally added to the 
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scheduler, but it didn’t make sense to take an order N 2 algorithm, turn it into an 
order N one, then turn it back to an order N 2 one with the addition of the calendar 
package. Besides, the scheduler is used to come up with feasible schedules. Once one 
is obtained, it can then be easily mapped to calendar dates. This separation of tasks 
also preserves the modularity of the codes. The conversion routine to convert from 
“continuous-time” to calendar dates (contocal) is in one of the appendices, as part 
of the scheduler package. 
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IV. 



EXPERTISE LEVELS 



Every programmer brings certain competencies to the tasks at hand. Some 
are experts in Ada, others in Java, etc. So, the scheduler has been modified to handle 
this. 

In the Shiah, et al. paper[Ref. 3] on scheduling multiple tasks, resources are 
represented by a vector data structure as follows: 

EAT = (EAT U EAT 2 , . . . , EAT r ) 

(EAT stands for earliest available time.) If a task is ready to be scheduled, and 
it requires resource AT, the earliest it can be scheduled is at time EAT n. If there 
are multiple instances of a resource then the resources are represented as a matrix, 
and the earliest time a task can be scheduled is the earliest time any one of the 
multiple instances of that resource is available. In Salah Badr’s thesis, he represented 
developers as the resources, and since he classified them as (low, medium, high) he 
could have multiple instances of developers. So the data structure to represent the 
available resources (developers) was a matrix. 

In this latest revision of the code, each developer is unique, there are no 
multiple instances of a developer, so resources (developers) are representeted as a 
vector. Each developer, though, has a capability attribute, which is a map of skills to 
(low, medium, high). For example, one of the inputs to the new scheduler program 
is a file of developers, as shown in Table IV. 

Each developer has an implicit attribute which is their name. Also, if a capa- 
bility is not given, it is assumed to be low . For example developer “Scott McNealy” 

Bill Gates {ActiveX : High, Java : Low} 

Scott McNealy {Java : High, Unix : Medium} 

Bill Joy {Java : High, Unix : High} 

Table IV. Sample developer file 
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Bill Gates 



{ActiveX : High, Java : Low, Unix : Low, 

Bill Gates : High, Scott McNealy : Low, Bill Joy : Low} 
Scott McNealy {ActiveX : Low, Java : High, Unix : Medium, 

Bill Gates : Low, Scott McNealy : High, Bill Joy : Low} 

Bill Joy {ActiveX : Low, Java : High, Unix : High, 

Bill Gates : Low, Scott McNealy : Low, Bill Joy : High} 

Table V. Sample developer file with implicit capabilities 

is assumed to have low ActiveX skills, while developer “Bill Gates” is assumed to 
have low Unix skills. If a task is to be scheduled that requires medium. Unix skills 
and low ActiveX skills then either developer “Scott McNealy” or “Bill Joy” could be 
assigned. On the other hand, if a task requires high ActiveX skills, then only “Bill 
Gates” would fit the bill. If a task came in that required high skills in both ActiveX 
and Java, no developer would fit the bill, and the scheduler code would through an 
Ada (noqualif ieddevelopers) exception. If a job came in that required high or 
medium skills in attribute “Scott McNealy” then only he could possibly be assigned 
this job. Table V shows what the capabilities of each developer are with the implicit 
capabilities added. 
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V. 



CONCLUSIONS 



A. SUMMARY OF DESIGN AND IMPLEMENTATION 

The scheduler as implemented can now handle large problems in a reasonable 
time, i.e., ten thousand or more tasks. The scheduled tasks can now be mapped to a 
realistic calendar, and the tasks are now associated with problem-solving skills 

B. FUTURE WORK 

The calendar implementation needs to be optimized. It currently runs in order 
N 2 time, but could easily be modified to run in order N time. At present the calendar 
model does not consider individual variations in schedules. If a developer were to take 
a day off, the model cannot handle that, as it is only aware of work days and holidays 
for the general work-force. To allow individual schedules into the model a group 
planning program of some kind would be needed. A kludge to get around this in the 
present implementaton, is to create pseudo-tasks lasting the period of time off, and 
requiring only that particular developer perform it. This causes some inaccuracies 
because the current scheduler in non-preemptive, but in real life time off could be 
scheduled in the middle of a task. This weakens the algorithm because it can fail to 
find feasible schedules in which tasks are interrupted by time off. 

Another enhancement that would be useful is the identification of critical 
paths. All schedules have critical paths, that is a sequence of tasks with the least 
laxity. It would be nice to enhance the scheduler to identify these critical paths. The 
project manager could then can focus his attention on those tasks in the critical path, 
as these would be the jobs that puts his schedule most at risk. 
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§ APPENDIX A INTRODUCTION 

1. Introduction. Here is the Ada code for utilites used in Salah Badr’s scheduler 
program. His program was written by him May 25, 1993. It was translated by myself, 
John Evans of NRaD, into Donald Knuth’s WEB format for literate programming. To 
compile and link the code in its present format you will need the Ada version of the WEB 
tool. 

It is available on-line via the world-wide-web at URL: 

http:/ /white.nosc.mil/~evansjr/literate/ 



2. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
get the book Literate Programming , by Donald Knuth, published by the Center for the 
Study of Language and Information, Stanford University, 1992. Another good source of 
information is the Usenet group comp. programming. literate. It has information on tools 
and answers to Frequently Asked Questions (FAQs). 

3. Who should use the WEB paradigm for programming? Well, not everybody. Here are 
a few paragraphs from Donald Knuth’s book that explains it best. 

4. Retrospect and Prospects. Enthusiastic reports about new computer languages, 
by the authors of those languages, are commonplace. Hence I’m well aware of the 
fact that my own experiences cannot be extrapolated too far. I also realize that, 
whenever I have encountered a problem with WEB, I’ve simply changed the system; 
other users of WEB cannot operate under the same ground rules. 

5. However, I believe that I have stumbled on a way of programming that produces 
better programs that are more portable and more easily understood and maintained 
than ever before; furthermore, the system seems to work with large programs as 
well as with small ones. I’m pleased that my work on typography, which began as 
an application of computers to another field, has come full circle and become an 
application of typography to the heart of computer science; I like to think of WEB as 
a neat “spinoff” of my research on TEX. However, all of my experiences with this 
system have been highly colored by my own tastes, and only time will tell if a large 
number of other people will find WEB to be equally attractive and useful. 
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INTRODUCTION 



APPENDIX A §6 

6. I made a conscious decision not to design a language that would be suitable for 
everybody. My goal was to provide a tool for system programmers, not for high 
school students or for hobbyists. I don’t have anything against high school students 
and hobbyists, but I don’t believe every computer language should attempt to offer 
all things to all people. A user of WEB needs to be good enough at computer science 
that he or she is comfortable dealing with several languates simultaneously. Since 
WEB combines T^X and Pascal with a few rules of its own, WEB programs can contain 
WEB syntax errors. T^X syntax errors, Pascal syntax errors, and algorithmic errors; 
in practice, all four types of errors occur, and a bit of sophistication is needed to 
sort out which is which. Computer specialists tend to be better at such things than 
other people. I have found that WEB programs can be debugged rapidly in spite of 
the profusion of languages, but I’m sure that many other intelligent people will find 
such a task difficult. 

7. In other words, WEB seems to be specifically for the peculiar breed of people who 
are called computer scientists. And I’m pretty sure that there are also a lot of 
computer scientists who will not enjoy using WEB; some of us are glad that tradi- 
tional programming languages have comparatively primitive capabilities for inserted 
comments, because such difficulties provide a good excuse for not documenting pro- 
grams well. Thus, WEB may be only for the subset of computer scientists who like 
to write and to explain what they are doing. My hope is that the ability to make 
explanations more natural will cause more programmers to discover the joys of lit- 
erate programming, because I believe it’s quite a pleasure to combine verbal and 
mathematical skills; but perhaps I’m hoping for too much. The fact that a least 
one paper has been written that is a syntactically correct ALGOL 68 program en- 
courages me to perservere in my hopes for the future. Perhaps we will even one day 
find Pulitzer prizes awarded to computer programs. 

8. Donald Knuth goes on to write about his hopes for the future of WEB programming. 
In an interview with Donald Knuth by Amazon Books on the release of a new edition of 
Volume 1 of The Art of Computer Programming (July 1, 1997) he was asked: 
Amazon.com: What do you see as the most interesting advance in programming since 
you published the first edition? 

Donald Knuth: It’s what I call literate programming, a technique for writing, docu- 
menting, and maintaining programs using a high-level language combined with a written 
language like English. This is discussed in my book Literate Programming. 

9. In the same book, Literate Programming , there is a chapter called How to read a WEB. 
But it is actually quite straightforward. 
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10 . Very briefly, each “Module” within angle brackets (< >) is expanded somewhere 

further down in the document. The trailing number you see within the brackets is where 
you can find this expansion. This provides a type of PDL (program descriptor language) 
for your program and greatly aids modularity and readability. It is also a highly effective 
method of top-down programming. The first module here is expanded further down, and 
contains most of the structure in standard Ada packages. 

( Package boiler-plate 12 ) 
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11. Schedule Tools. 

12. Here, finally, is the boilerplate. The Ada WEB tool atangle reads this and knows to 
write out two separate files, the specification and the body. (The Ada WEB tool aweave 
will write out just one documentation file.) 

( Package boiler-plate 12 ) = 

output to file schedtools.ads 

with Text JO] 
use Text JO] 
with generics et.pkg] 
with generic.map.pkg ] 
with Generic Jist] 
with SchedPrims] 
use SchedPrims ; 
with capability] 
use capability] 
with ustrings] 
use ustrings] 
package schedtools is 
( Instantiate generics 16 ) 

( Specification of types and variables visible from schedtools 23 ) 

( Specification of procedures visible from schedtools 26 ) 
end schedtools ; 

output to file schedtools .adb 

with testsojpkg] 
use test-io-pkg ; 

with Ustrings] Use Ustrings] with Ada. calendar] 

use Ada .calendar] 

with calyr] 

use calyr] 

with capability ; 

use capability ; 

package body schedtools is 

(Variables local to schedtools 41 ) 

(Procedures and Tasks in schedtools 42) 
end schedtools ; 

This code is used in section 10. 
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13. The scheduling tools in this package rely on some other packages. Here is how they 
relate to each other. 

Generic List Pkg SchedPrims Pkg 




SchedTools Pkg 

I 

Scheduler 



Library Dependence Structure. 

14. The schedules are kept in in linked-lists. Salah Badr’s original code had separate 
routines for each linked list. In this version of the algorithm, I created a generic list type, 
and make multiple instantiations of it for different record types. Details of the differing 
records, comparisons, and display routines can be found in the schedprims package. 

15. Since the main purpose of rewriting the code was to eliminate the order IV 2 space 
requirement, I use linked lists to keep track of additions and deletions to the lists as the 
search space is traversed. What follows are all the instantiations of new linked-lists. 

16. Here I instantiate a list type to manipulate StepRecord types. 

(Instantiate generics 16 ) = 

package InputListl is new GenericJist(ElementType =$■ StepRecord , 

Display Element =>■ Display StepRecord , =4> ComparelD ); 

use InputListl ; 

subtype InputList is InputListl .List; 

See also sections 17, 18, 19, 20, 21, and 22. 

This code is used in section 12. 

17. Here I instantiate a list type to manipulate StepRecord types, but to restore deletions, 
in case the recursive procedure Branch AndB ound needs to back out changes. 

(Instantiate generics 16) += 

package DeletedlnputListl is new Generic Jist (Element Type StepRecord , 
DisplayElement Display StepRecord , M < M CompareRecursionLevel ); 

use DeletedlnputListl ; 

subtype DeletedlnputList is DeletedlnputListl .List] 
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18. Here I instantiate a list type to manipulate StepRecord types for the Ready Queue , 
which requires that the records be sorted in Deadline first order. 

{ Instantiate generics 16 ) += 

package ReadyListl is new GenericJist(ElementType =$> StepRecord , 

Display Element => Display Step Record => CompareDeadline , => IsEqual) 

use ReadyListl ; 

subtype ReadyList is ReadyListl .List ; 

19. Here I instantiate a list type to manipulate StepRecord types for deletions to the 
ReadyQueue , which requires that the records be sorted in RecursionLevel first order. 

{ Instantiate generics 16 ) -f= 

package DeletedReadyListl is new Generic Jist(ElementType => StepRecord , 
DisplayElement Display StepRecord =£• CompareRecursionLevel ); 

use DeletedReadyListl ; 

subtype DeletedReadyList is DeletedReadyListl .List] 

20. Here I instantiate a list type to manipulate StepRecord types for additions to the 
ReadyQueue , which requires that the records be sorted in RecursionLevel first order. 

{ Instantiate generics 16 ) += 

package AddedReadyListl is new Generic Jist (Element Type =£> StepRecord , 
DisplayElement => Display StepRecord =>• CompareRecursionLevel ); 

use AddedReadyListl ; 

subtype AddedReadyList is AddedReadyListl .List] 

21. Here I instantiate a list type to manipulate StepRecord types for the ReadyQueue , 
which requires that the records be sorted in Deadline first order. 

{ Instantiate generics 16 ) += 

package ScheduleListl is new Generic Jist (ElementType =$■ ScheduleRecord , 
DisplayElement =$> Display Schedule Record , "<" => Compare StartTime)] 
use ScheduleListl ; 

subtype ScheduleList is ScheduleListl .List] 

22. Here I instantiate a list type to manipulate StepRecord types for the ReadyQueue , 
which requires that the records be sorted in Deadline first order. 

( Instantiate generics 16 ) += 

package CalendarListl is new Generic Jist(ElementType Calendar Record , 

DisplayElement =£> Display Calendar Record => Compare StartTime)] 

use CalendarListl ; 

subtype CalendarList is CalendarListl .List] 
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23. Made global and visible. 

{ Specification of types and variables visible from schedtools 23 } = 
maxjrecursion : natural <— 0; 
recursion Aevel : natural <— 0; 

See also sections 24, 25, 33, and 59. 

This code is used in section 12. 

24. When the laxity of the input schedule is “tight,” it may be impossible to find a 
schedule. (Finding a schedule is, after all, an NP-Complete problem.) In this case the 
routine will give up after some amount of effort. In this implementation, I give up if the 
number of “backtracks” is FeasFactor times the total of number of tasks to be scheduled. 
If this number is exceeded then the exception NoFeasibleScheduleFound is thrown. 

(Specification of types and variables visible from schedtools 23) += 
NoFeasibleScheduleFound : Exception ; 

FeasFactor : natural <— 10; 

25. Made global and visible. 

( Specification of types and variables visible from schedtools 23 ) += 

StepList : InputList\ 

ReadyQueue : Ready List ; 

DeletedReady Queue : DeletedReadyList ; 

DeletedlnputQueue : DeletedlnputList ; 

AddedReady Queue : AddedReadyList ; 

Schedule : ScheduleList ; 

Calendar : CalendarList\ 

FinalS chedule : ScheduleList ; 

26. Print all the records in the Step fist. 

( Specification of procedures visible from schedtools 26 ) = 
procedure PrintAllStep Records (L : in InputList ); 

See also sections 27, 28, 29, 30, 31, 32, 34, 35, 36, 37, 38, and 39. 

This code is used in section 12. 

27. Print all the records in the Step list. 

( Specification of procedures visible from schedtools 26 ) += 
procedure PrintAllStepRecords (L : in Ready List)] 

28. Print all the records in the Schedule list. 

( Specification of procedures visible from schedtools 26 ) += 
procedure Print AllScheduleRecords (L : in ScheduleList ); 
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29. Print all the records in the Schedule list. 

(Specification of procedures visible from schedtools 26 ) += 

procedure Print AllCalendarRecords (L : in out ScheduleList ); 

30. Print all the records in the Schedule list. 

{ Specification of procedures visible from schedtools 26 ) += 
procedure SaveAllScheduleRecords ( L : in out ScheduleList ); 

31. Creating new step from a file and finking it to the step list. 

(Specification of procedures visible from schedtools 26 ) += 
procedure CreateNewStepList(L : in out InputList)] 

32. 

(Specification of procedures visible from schedtools 26 ) +•= 

Procedure CreateDeadlineFirstSchedule(mr : in out natural] num-developers : natural ); 



33. 

( Specification of types and variables visible from schedtools 23 ) += 
type DesignerMatrix is array (POSITIVE range <>) of natural ; 

34. Creating a new schedule record 

( Specification of procedures visible from schedtools 26 ) += 

procedure CreateS cheduleRecord (Rec : out ScheduleRecord] S-ID : in 
natural] TIME 1 : in natural] TIMES : in natural] S-L EVE L : in 
cap-map .map] Developer : in ustring ); 



35. 

( Specification of procedures visible from schedtools 26 ) += 

procedure LevelMinmum(MATRIX : in DesignerMatrix] LEVEL : in 
cap-map .map ] J : in out natural)] 

36. checking the in-degree of the successors of the assigned step. This works with 
deadline heuristic 

( Specification of procedures visible from schedtools 26 ) += 

procedure CheckInDegree(Rec : in StepRecord] Queue : in out ReadyList] InList : in 
out InputList] finish-t : in natural ); 



37. 

( Specification of procedures visible from schedtools 26 ) += 

procedure Strongly Feasible (Queue : in out ReadyList] MATRIX : in 
DesignerMatrix-, FEASIBLE : in out boolean)] 
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38. Assign a step to a designer according to its deadline and its expertise level 

( Specification of procedures visible from schedtools 26 ) += 

procedure As signStep {Current : S tep Record ] MATRIX : in out Designer Matrix] 
Sch : in out ScheduleList] Finish : in out natural] FEAS : out boolean)] 



39. 

{ Specification of procedures visible from schedtools 26 ) += 

procedure BranchAndBound^S.List : in out InputList] R-Queue : in out ReadyList] 
F-Sched : in out ScheduleList] MATRIX : in De sign erMatrix] Found : in out 
BOOLEAN); 
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40. Schedule Tools Body. 

41. Global variable used to identify different tasks. 

{ Variables local to schedtools 41 ) = 

StepID : natural *— 1; 
data-file , data2-file : file-type ; 

FOUND : boolean <— FALSE; 

FEASIBLE : boolean «- TRUE; 
debug : boolean <— false \ 
debugB : boolean <— false] 

StartTime : Time ; 

dailyhours : WorkHours *— (ConvertHoursToDuration(S), ConvertHoursToDuration(8), 
ConvertHours ToDuration (8), ConvertHours ToDuration (8), 
ConvertHoursToDuration( 8)); 

NRaD : boolean <— false] 

See also sections 55 and 56. 

This code is used in section 12. 



42. Print all the records in the STEP list. 

( Procedures and Tasks in schedtools 42 ) H 

procedure Print AllStepRecords{L : in InputList ) is 
begin 

StepRecordHeading ; Display (T); 
end PrintAllStepRecords ; 

See also sections 43, 44, 45, 47, 49, 52, 53, 57, 58, 62, 66, 70, and 71. 
This code is used in section 12. 



43. Print all the records in the STEP list. 

( Procedures and Tasks in schedtools 42 ) += 

procedure Print AllStepRecords (L : in ReadyList ) is 
begin 

StepRecordHeading ; Display (L); 
end PrintAllStepRecords ; 

44. Print all the records in the STEP list. 

( Procedures and Tasks in schedtools 42 ) += 

procedure Print AllScheduleRecords (T : in ScheduleList ) is 
begin 

ScheduleRecordHeading ; Display (T); 
end Print AllScheduleRecords ; 
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45. Print all the records in the STEP list. 

( Procedures and Tasks in schedtools 42 ) += 

procedure SaveAllScheduleRecords (L : in out ScheduleList ) is 
input : Ustring ; 
size : natural ; 
cur : ScheduleRecord ; 
begin 

( Get output file name 46 ) 

put_fme("Opening u your u output u f ile. "); create (data2. file, out. file , S (input))-, 
size <— ListSize(L); rewind (L); 
for i G 1 . . size loop 
if i = 1 then 

getCurrent(L, cur); 
else 

getNext(L, cur); 
end if; 

S aveS cheduleRecord ( cur , data2.fi.le); 

end loop; 

end SaveAllScheduleRecords ; 



46. 

( Get output file name 46 ) = 

puL/t7ie( M Please u Enter u 0utput u File L |Name: u "); get-line (input); 
This code is used in section 45. 

47. Print all the records in the STEP list. 

{ Procedures and Tasks in schedtools 42 ) += 

procedure PrintAllCalendarRecords (L : in out ScheduleList) is 
size : natural; 
cur : ScheduleRecord ; 
cal : Calendar Record ; 
dur : Duration; 
begin 

CalendarRecordHeading ; 

(Convert ScheduleList to CalendarList 48} Display (Calendar); 
end PrintAllCalendarRecords ; 
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48 . 

( Convert ScheduIeList to C alendarList 48 ) = 

MakeEmpty (Calendar ); size <— ListSize(L)] Rewind(L)] 
for * E 1 . . size loop 
if i = 1 then 

GetCurrent(L, cur)' 
else 

GetNext(L , cur)] 

end if; 

dur <— ConvertHoursToDuration(cur .StartTime)] 

cal .StartTime <— DurationToCalendarTime (StartTime , dailyhours , dur , NRaD)] 
dur <— ConvertHoursToDuration(cur.FinishTime)] 

cal .Finishtime < — Durationto Calendar Time (StartTime , dailyhours , dur , NRaD)] 
cal.StepId <— cur .Stepld] cal. Designer <— cur .Designer] 

cap_map .assign(cal .StepLevel, cur .StepLevel)] Ins ertln Order (Calendar , cal)] 

end loop; 

This code is used in section 47. 
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{ Procedures and Tasks in schedtools 42 ) += 

procedure CreateNewStepList(L : in out InputList) is 
sr : StepRecord ; 
input : U string ; 
do-alternate : boolean <— false] 

( Variables local to CreateNew Step List 51 ) 
begin 

MakeEmp ty(L)] 

Stepld <— 1; 

puL/me( M Please u Enter uu INPUT u FILE u NAME u " ); 
get-line (input ); 

put-line ( " Openinguy our u dat a u f i 1 e u " ) ; 
open (data- file , in-file, S(input))] 
while -‘end-of .file (data- file) loop 
sr . Stepld <— StepID ; 

if do-alternate then 

DeadTime <— get-date (data-file)] 
else 

nat-io .get( data-file , sr .Deadline ); 

end if; 

nat-io .get( data-file , sr .Priority ) ; 

nat-io .get ( data-file , sr .EstimatedDuration ); 

if do-alternate then 

Earlytime get-date (data-file); 
else 

nat-io .get (data-file , sr .EarliestStartTime)] 

end if; 

getfset(dato-file, sr .Predecessors ); 
getfset ( data-file , sr .Successors ); 
declare 

yrcap : cap-map .map ; 
begin 

get-capability (data-file , yrcap)] cap-map ,assign(sr .ExpLevel , yrcap)] 

end; 

sr .InDegree +— natset .size(sr .Predecessors)] 
if do-alternate then 

( Convert calendar times to absolute times 50 ) 
else 

StartTime <- Time- Of (1997, 7, 3, 0.0); 

end if; 

AddToEnd (L, sr)] StepID <— StepID + 1; 

end loop; 
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CLOSE (data^file ); 
end CreateNewStepList ; 



50 . 

( Convert calendar times to absolute times 50 ) = 
if StepID = 1 then 

StartTime 4— Earlytime ; 
end if; 

dur 4— CalendarTimeToDuration (StartTime, dailyhours , Deadtime , NRaD)-, 
sr .Deadline 4— ConvertDurationToHours(dur ); 

dur 4— Calendar Time To Duration (StartTime , dailyhours , Early Time , NRaD ); 
sr .EarliestStartTime 4— ConvertDurationTo Hours (dur ); 

This code is used in section 49. 



51 . 

( Variables local to CreateNewStepList 51 ) = 
dur : Duration ; 

Early Time , DeadTime : Time ; 

This code is used in section 49. 



52 . 

(Procedures and Tasks in schedtools 42) += 

procedure RelnitializeMatrix (MATRIX : in out Designer Matrix) is 
begin 

for i G 1 . . matrix 1 length loop 
matrix ( i ) 0; 

end loop; 

end RelnitializeMatrix ; 
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53. Creating new step. 

(Procedures and Tasks in schedtools 42) += 

Procedure CreateDeadlineFirstSchedule (mr : in out natural \num_dev elopers : natural ) 
is Current : StepRecord ; 

Feasible : boolean <— True ; 
eat : designermatrix( 1 .. num.developers); 
begin 

Kntr <— ListSize(StepList ); (Initialize the lists for intensive list-processing 54) 

Rewind (Step List)] GetCurrent(StepList , Current ); 
for i 6 1 . . Kntr loop 

if Current .InDegree = 0 then 

DeleteCurrent(StepList ); Ins ertlnOrder (Ready Queue , Current ); 
if i < Kntr then 

GetCurrent(StepList , Current)] 
end if; 
else 

if i < Kntr then 

GetNext(StepList , Current)] 

end if; 
end if; 
end loop; 

Feasible +— True] Found <— False] RelnitializeMatrix(EAT)] 

StronglyFeasible (Ready Queue , EAT , Feasible)] 
if Feasible then 

puL/me("Calling u BranchAndBoundijRoutine . " ); 

BranchAndBound(StepList , ReadyQueue , Schedule , EAT , FOUND ); 
puL/me( ,, Returned u from L) BranchAndBound 1J Routine . " ); 
end if; 

if FOUND then 

put_/me("SDRRY u THERE u IS u NO u FEASIBLE u SCHEDITLE"); 
end if; 

mr *— max-recursion] 
end CreateD eadlineFirstS chedule ; 

54. If this is not the first time this routine is called then it behooves us to clean up the 
old lists from previous processing. If this is the first time, no harm done. 

( Initialize the lists for intensive list-processing 54 ) = 

MakeEmpty (ReadyQueue ); Make Empty (Schedule)] MakeEmpty (DeletedReady Queue ); 
MakeEmpty (D eletedlnputQueue)] MakeEmpty (AddedReady Queue ); 

This code is used in section 53. 
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55. 

( Variables local to schedtools 41 ) += 
kntr : integer <— 0; 



56. 

( Variables local to schedtools 41 ) += 

counter : natural <— 0; ®{.Used for tracking backtracking <8} 

57. Creating a new schedule record 

( Procedures and Tasks in schedtools 42 ) += 

procedure CreateS cheduleRecord (Rec : out ScheduleRecord ; S-ID : in 
natural] TIME 1 : in natural] TIME2 : in natural] S -LEV EL : in 
cap-map .map] Developer tin ustring) is 

begin 

Rec .StepID <— S-ID] Rec .StartTime <— TIME1] Rec .Finish Time <— TIME2] 
Rec .Designer <— Developer] cap-map ,assign(Rec .StepLevel, S-LEVEL)] 
end Create ScheduleRecord] 

58. 

(Procedures and Tasks in schedtools 42 ) += 

procedure LevelMinmum(MATRIX : in Designer Matrix] LEVEL : in 
cap-map .map ] J : in out natural ) is 
min : natural] 
n : natural ; 
begin 

j < — 0; min <— natural' last] n <— 1; 
if is~ qualified {lev el ,n) then 
j *— 1; min <— matrix {1)] 

end if; 

for m € 2 . . matrix' length loop 
if matrix (m) < min then 
if is-qualified (level, m) then 
min *— matrix (m)] j <— m; 
end if; 
end if; 
end loop; 
if j = 0 then 

raise noqualifieddevelopers ; 
end if; 

end levelminmum] 
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59 . 

{ Specification of types and variables visible from schedtools 23 ) += 
noqualifieddevelopers : exception; 
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60. Check In Degree. Checking the in-degree of the successors of the assigned step. 
This works with deadline heuristic 

61. Presently changes the start-time of any successors. Will need to modify when I 
convert the updates from a recursive local variable to a global one. Also deletes a scheduled 
task from the INPUT-LIST . Then it updates the queue of “ready” tasks. 




Precedence Graph 
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62. This procedure loops through the entire InputList finding the successors of Rec. 
Once found it updates the EarliestStartTime . Also, if the InD egret reaches zero this 
means it no longer is waiting on a predessor to be scheduled, it is “ready” to be sceduled — 
that is, moved from the InputList to the ReadyQueue . 

Note: It appears that the Predecessor field of the StepRecord is ignored. Only the 
successor field is used. 

(Procedures and Tasks in schedtools 42} += 

procedure CheckInDegree(Rec : in StepRecord-, Queue : in out ReadyList ; InList : in 
out InputList] finish. t : in natural ) is 
Current : StepRecord ; 
t : natset .set < — Rec .Successors ; 
k, kntr : natural ; 

FOUND : boolean <- FALSE; 
deleted : boolean *— false] 
begin 

if naLset .size(t) ^ 0 then 

Rewind (InList)] kntr «— ListSize (InList)] GetCurrent(InList , Current)] 
for i 6 1 • • kntr loop 
k <— Current .Step Id] 
if naLset. member (k,t) then 

if Current .EarliestStartTime < finish-t then 
Current .Earliest Starttime *— finish-t] 
end if; 

Current. InDegree < — Current .InDegree — 1; 
if Current .InDegree = 0 then 

( Move record from input list to ready fist 64 ) 
else 

Update Current (InList, Current)] 

end if; 
end if; 

( Get next record 63 ) 

end loop; 
end if; 

end ChecklnDegree] 
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63. 

( Get next record 63 ) = 
if % < kntr then 
if deleted then 

GetCurrent(InList, Current)] deleted <— false; 
else 

GetNext(InList , Current ); 

end if; 
end if; 

This code is used in section 62. 



64 . 

{ Move record from input list to ready list 64 ) = 

Delete Current (InList); Current .recursionlevel ♦— recursion-level; 

InsertlnOrder (Queue , Current ); InsertlnOrder (AddedReady Queue , Current); 

Current. InDegree *— Current. Indegree + 1; 

InsertlnOrder (Deletedlnput Queue , Current); deleted *— true; 
if debug then 

puL/me("Moving u Record u to u DeletedInput Queue . " ); Display (DeletedlnputQueue) 
end if; 

This code is used in section 62. 
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STRONGFEASIBLE 



65. StrongFeasible. Checking the feasibility of the schedule with each step in the 
ready queue. 
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66. Definition: A partial feasible schedule is said to be strongly-feasible if all the 

schedules obtained by extending the current schedule with any one of the remaining tasks 
are also feasible. Thus, if a partial feasible schedule is found not to be strongle-feasible 
because, say, task T misses its deadline when the current schedule is extended by T, then 
it is appropriate to stop the search since none of the future extensions involving task T 
will meet its deadline. In this case, a set of tasks can not be scheduled given the current 
partial schedule. (In the terminology of branch-and-bound techniques, the search path 
represented by the current partial schedule is bound since it will not lead to a feasible 
complete schedule.) 

( Procedures and Tasks in schedtools 42 ) += 

procedure Strongly Feasible [Queue : in out ReadyList-, MATRIX : in 
DesignerMatrix] feasible : in out boolean ) is 
temp : natural ; 

J : natural < — 1; 

L : natural <— 1; 
min : natural < — 0; 
kntr : natural <— 0; 
myonum : natural *— 0; 

Current : StepRecord ; 

Myopic-Num : constant natural *— 7; 
begin 

if debug then 

puLLine ("StronglyFeasible> u Start u M ); 
end if; 

feasible <— True ; kntr <— ListSize(Queue)\ (Compute myopic number 67) 

Rewind ( Queue ); 
for i (E 1 . . myonum loop 
if -i feasible then 
exit; 
end if; 
if i = 1 then 

GetCurrent(Queue , Current ); 
else 

G etN ext ( Queue , Current ); 

end if; 

LevelMinmum[MATRIX , Current .ExpLevel , J); min *— MATRIX (J); 

( Debug code set 1 68 ) 
if min > Current .EarliestStartTime then 
temp <— min; 
else 

temp ir— Current .EarliestStarttime] 

end if; 

temp <— temp + Current. EstimatedDuration] (Debug code set 2 69) 
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if temp > Current. Deadline then 
feasible <— False ; 

end if; 
end loop; 

end Strongly Feasible ; 

67. Without this tidbit of code, the algorithm goes from order n to order n 2 . 

( Compute myopic number 67 ) = 
if kntr > Myopic-Num then 
myonum <— Myopic.Num\ 
else 

myonum <— kntr ; 
end if; 

This code is used in section 66. 



68 . 

( Debug code set 1 68 ) = 
if debug then 

put("StronglyFeasible> u Id u = u "); nat-io .put(Current .Stepld , 1); 
put(" uu min u = u "); nado.put(min, 2); put (" . u Current .EarliestStartTime uu = u " ); 
nado .put (Current .EarliestStartTime , 2); put-line{" .u")i 
end if; 

This code is used in section 66. 

69. 

( Debug code set 2 69 ) = 
if debug then 

put ("StronglyFeasible> u " ); naLio .put{i, 2); put{" . u temp u = u " ); 
natAo .put (temp , 2); put( n . uu Current .Deadline u = u "); 
nado .put (Current .Deadline , 2); put-line (" .u'')5 
end if; 

This code is used in section 66. 
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70. AssignStep. Assign a step to a designer according to its deadline and its expertise 
level: BRANCH AND BOUND CASE 

( Procedures and Tasks in schedtools 42 ) += 

procedure AssignStep (Current : in StepRecord; MATRIX : in out 

Designer Matrix-, Sch : in out ScheduleList; Finish : in out natural; FE AS : out 
boolean ) is 
J : natural; 

MIN : natural; 

temp : natural <— 0; 

tempi : StepRecord <— Current; 

Dummy : ScheduleRecord ; 
begin 

LevelMinmum(MATRIX , Current. ExpLevel, J); MIN <— MATRIX (J); 
if MIN < Current .EarliestStartTime then 

temp <— Current. EarliestStartTime; finish <— temp + Current. EstimatedDuration; 
if finish > Current. DEADLINE then 
FEAS 4 - FALSE; 
else 

FEAS +— TRUE; MATRIX (J) <— finish; CreateS cheduleRecord (Dummy , 
tempi .StepID , temp , finish , tempi .ExpLevel , g et. dev eloper-name (j)); 
AddToEnd (Sch , Dummy); 

end if; 
else 

temp <— MIN ; finish <— temp + Current. EstimatedDuration; 
if finish > Current. Deadline then 
FEAS <- FALSE; 
else 

FEAS *— TRUE; MATRIX (J) <— finish; CreateS cheduleRecord (Dummy , 
tempi .StepID , temp , finish , tempi .ExpLevel , geLdeveloper^name (j)); 
AddToEnd(Sch , Dummy); 

end if; 
end if; 

end AssignStep ; 
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71. Branch And Bound. 



BRANCH AND BOUND 



( Procedures and Tasks in schedtools 42 ) += 

procedure BranchAndBound(S-List : in out InputList] iL Queue : in out ReadyList ; 
F-Sched : in out ScheduleList] MATRIX : in Designer Matrix ; Found : in out 
BOOLEAN) is 

( Variables local to Branch AndBound 73 ) 
begin 

( Update some recursion stuff 72 ) 
if IsEmpty(R-Queue) then 
if do-verbose then 

ScheduleRecordHeading ; Print AllScheduleRecords ( F-Sched ); newJine ; 

end if; 

put("Backtracking u := u " ); test-io-pkg .put (counter)] newJine] 

^■{.Copy (F-Sched , FinalSchedule)] ® y Found «— True] 
if debug then 

put-line ("Founduayvaliduschedule . " ); 
end if; 

elsif -i found then 

OrigSize <— ListSize(R_ Queue)] 
for i IN 1 . . OrigSize loop 

( Update backtrack counter 74 ) 

( Copy linked lists and the designer matrix onto the stack 80 ) 

(Get appropriate R-Queue record 76) 
if debug then 

put ("BranchAndBound^CurrentL^y" ); Display StepRecord ( Current)] 
put ( "BranchAndBound> u List Size (R_Queue) u isu" ); 
nat-io .put (ListSize(R. Queue))] puLline(" . u ")> 

end if; 

AssignStep ( Current , MA T , F-Sched , FinishTime , Feasible ); 

ChecklnD egree ( Current , R- Queue , S-List , FinishTime ); 

(Delete appropriate R-Queue record 78) 
if debug then 

put-line ("Aft er u assigning u st ep , ubutybef ore u testing u f or u Feasibility : '§); 
PrintAllStepRecords (iL Queue)] Print AllScheduleRecords ( F-Sched ); 

end if; 

StronglyFeasible(R-Queue , MAT , Feasiblel ); 
if Feasiblel then 

BranchAndBound (S-List , R-Queue , F-Sched , MAT , Found)] 

( Update recursion stuff again 79 ) 

end if; 

( Free up local linked lists 83 ) 
if Found then 
exit; 



43 



BRANCH AND BOUND 



APPENDIX A 



§71 



end if; 
end loop; 

if recursion-level < 1 then 
if debug then 

puL/me("BranchAndBound>yFinished u unwindingytheystack . " ); 
end if; 
end if; 
end if; 

end Branch AndBound ; 



72 . 

(Update some recursion stuff 72) = 

if ( diagsched V diagstep V diag-ready-queue) then 
do-verbose <— true] 

end if; 

recursion-level <— recursion-level + 1; 
if recursion-level > max-recursion then 
max-recursion *— recursion-level] 

end if; 

This code is used in section 71. 



73 . 

(Variables local to Branch AndBound 73) = 
do-verbose : boolean <— false] 

OrigSize : natural] 

See also sections 75, 77, 82, 85, 88, and 90. 

This code is used in section 71. 



74 . 

( Update backtrack counter 74 ) = 
if i ^ 1 then 

counter < — counter + 1; 

end if; 

TotSize <— ListSize(R- Queue) + ListSize(S-List) + ListSize(F-Sched)] 
if counter > ( FeasFactor * TotSize) then 
raise NoFeasibleScheduleFound] 
end if; 

This code is used in section 71. 



75 . 

(Variables local to Branch AndBound 73) += 
TotSize : natural] 
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76. 

(Get appropriate R- Queue record 76) = 

appropriate <— i — ( 0 rig Size — ListSize(R- Queue))] 
if debug then 

ptxt("BranchAndBound> u Getting u number u "); nat-io .put(Appropriate , 1); 
put (" u record u in u Ready u Queue. "); puf("(i u =u")> nat-io .put(i, 1); 
put (" , u 0rigsize u = u "); nat-io .put( Origsize , 1); put-Iine("') . "); 
end if; 

G etNth(R- Queue , appropriate , Current ); 

This code is used in section 71. 



77. 

( Variables local to Branch AndBound 73 ) += 
appropriate : natural ; 

78. 

( Delete appropriate R _ Queue record 78 ) = 
if debug then 

putJine ("Deleting u appropriate u R_Queue u record. " ); 
end if; 

GetNth{R_ Queue , appropriate , Current)-, DeleteCurrent(R-Queue)-, 
Current. RecursionLev el <— Recursion- Lev el ; 

Ins ertln Order (DeletedReady Queue , Current ); 
if debug then 

puL/me("Finished u deleting L jappropriateuR_Queue L jrecord. " ); 
end if; 

This code is used in section 71. 



79. 

( Update recursion stuff again 79 ) = 
recursion-level <— recursion-level — 1; 
This code is used in section 71. 



80. As far as I can see the step list is never modified, so why is it copied? Aha! It is 
modified in procedure check-in-degree . 

( Copy finked fists and the designer matrix onto the stack 80 ) = 

( Do diagnostics 81 ) 

®{.Copy (S-List , InList)] Copy(R-Queue, Queue)] Copy (F-Sched , Sched)] 
ayMAT MATRIX] 

This code is used in section 71. 
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81. 

( Do diagnostics 81 ) = 
if do-verbose then 

put-line ("======================================================="); 

/mt("Recursioii u level u is u "); nat-io .put(recursion-level)] put-line ( " . u "); 
end if; 

if diagstep then 

PrintAllStepRecords ( S-List ); 
end if; 

if diag-ready-queue then 

PrintAllStepRecords ( R-QUEUE)] 
end if; 

if diagsched then 

Print AllS chedule Records ( Fsched ); 
end if; 

This code is used in section 80. 

82 . 

( Variables local to BranchAndBound 73 ) += 
diagstep : boolean *— false] 
diag-ready-queue : boolean *— false] 
diagsched : boolean *— false] 

83 . 

( Free up local linked lists 83 ) = 

Q{.MakeEmpty(InList)] MakeEmpty (Queue)] MakeEmpty(Sched)] 

<B}( Restore R- Queue 84) 

( Restore S-List 86 ) 

( Restore F-Sched 89 ) 

This code is used in section 71. 
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84. 

(Restore R-Queue 84) = 
if -<Found then 
if debug then 

puLline ( "Rest or ing u R_ Queue . " ); 
end if; 

Dsize *— ListSize(AddedReady Queue)] 
if Dsize ^ 0 then 

GetNth(AddedReady Queue , Dsize , Current)] 
while Current .recur sionlev el = recursion-level loop 
DeleteCurrent(AddedReadyQueue)] 

Delete Matching (R.Queue , Current , Success ); 
if debug then 

put ( "Delet ingurecordu" ) ; put-line ( "From,jReadyQueue . " 

Display Step Record ( Current ); 

end if; 

if -i Success then 

puLZ/ine ("Didijnotijf indumatchingurecord ! " ); 
end if; 

Dsize *— ListSize(AddedReady Queue)] 
if Dsize = 0 then 
exit; 
else 

GetNth(AddedReady Queue , Dsize , Current)] 

end if; 
end loop; 
end if; 

Dsize <— ListSize(DeletedReady Queue)] 

GetNth(D el etedReady Queue , Dsize, Current)] D eleteCurrent{D eletedReady Queue ); 
InsertInOrder(R- Queue, Current)] ( Reset InDegree 87) 
if debug then 

put_/me("Finished L |restoringuR_Queue. " ); 
end if; 
end if; 

This code is used in section 83. 

85. 

( Variables local to Branch AndBound 73 } += 

Success : boolean ; 
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86 . 

( Restore S-List 86 ) = 
if ->Found then 

Dsize <— ListSize(DeletedInputQueue ); 
if Dsize / 0 then 

GetNth(D eletedlnputQueue , Dsize, Current ); 
while Current .recur sionlev el — recursion-level loop 

DeleteCurrent(D eletedlnputQueue ); Ins ertlnOrder (S-List , Current ); 
{ Reset InDegree 87 ) 

Dsize <— ListSize(DeletedInputQueue ); 
if Dsize ^ 0 then 

GetNth(DeletedInputQueue , Dsize , Current ); 
else 
exit; 
end if; 
end loop; 
end if; 
end if; 

This code is used in section 83. 
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87. 

( Reset InDegree 87 ) = 
if debug then 

put ("Resetting u InDegree u for u successors u of u :u" )> Display StepRecord (Current)] 
end if; 

Dsize <— ListSize(S-List ); t <— Current. Successors] Rewind (S-List)] 
for i G 1 . • Dsize loop 
if i = 1 then 

GetCurrent(S-List , Current ); 
else 

GetNext(S.List , Current ); 

end if; 

k < — Current .S tepid] 
if debug then 

put ("Stepld u = u "); put(k)] put(" . uu Now u checking u for u membership. "); 
end if; 

if naLset .member (k,t) then 
if debug then 

putJine (" (Member) " ); Display StepRecord ( Current ); 

end if; 

Current. InDegree <— Current. InDegree +1; UpdateCurrent(S-List , Current)] 
if debug then 

Display Step Record ( Current)] 
end if; 
else 

if debug then 

puCline ( " (Not u Member) " ); 
end if; 
end if; 
end loop; 

This code is used in sections 84 and 86. 



88 . 

( Variables local to Branch AndBound 73 ) += 
t : natset .set] 
k : natural] 
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89 . 

( Restore F-Sched 89 ) = 
if -<Found then 
if debug then 

puLline (”Restoring u F_Sched. " ); 
end if; 

Dsize *— ListSize (F-Sched)', GetNth (F-Sched , Dsize , D Current)] 
DeleteCurrent(F-Sched)-, 
if debug then 

put-line ( "Finished u rest oring u F_Sch.ed. "); 
end if; 
end if; 

This code is used in section 83. 



90. 

(Variables local to Branch AndBound 73) += 
InList : InputList] 

D Current : Schedule Record ; 

®{.Queue : ReadyList\ 

Sched : ScheduleList ; 

Dsize : natural ; 

Current : StepRecord ; 

MAT : Designer Matrix ( 1 .. matrix 1 length)] 
Feasible : BOOLEAN <- TRUE; 

Feasiblel : BOOLEAN <- TRUE; 

FinishTime : natural 0; 
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91. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

92. I enclose the RCS Keywords here as well, since that is how I keep track of versions. 

$RCSfile: schedtools.aweb,v 
$Revision: 1.5 
$Date: 1997/08/24 22:27:29 
$ Author: evansjr 

$Id: schedtools.aweb,v 1.5 1997/08/24 22:27:29 evansjr Exp evansjr 

$Locker: evansjr 
$State: Exp 
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93. Index. Here is a cross-reference table for the schedtools package. All modules 
in which an identifier is used are listed with that identifier, except that reserved words are 
indexed only when they appear in format definitions, and the appearances of identifiers 
in module names are not indexed. Underlined entries of subprograms and packages corre- 
spond to sections where this entity is specified, whereas entries in italic type correspond 
to the section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



Ada : 12. 

AddedReadyList : 20, 25. 

AddedReadyListl : 20 . 

AddedReady Queue: 25, 54, 64, 84. 

AddToEnd: 49, 70. 
appropriate : 76-78. 

Appropriate: 76. 

assign: 48-49, 57. 

AssignStep: 38, 70, 71. 

backtracking : 56. 

boolean: 37-38, 41, 49, 53, 62, 66, 70, 

73, 82, 85. 

BOOLEAN: 39, 71, 90. 

BranchAndBound: 17, 39, 53, 71. 

cal: 47-48. 

Calendar: 25, 47—48. 

calendar: 12. 

CalendarList: 22, 25. 

CalendarListl : 22. 

Calendar Record : 22, 47. 

CalendarRecordHeading : 47. 

CalendarTimeToDuration: 50. 

calyr: 12. 

cap.map: 34-35, 48-49, 57-58. 
capability : 12. 

check-in-degree: 80. 

ChecklnDegree: 36, 62, 71. 

CLOSE: 49. 

CompareDeadline: 18. 

ComparelD : 16. 

CompareRecursionLevel: 17,19-20. 

Compare Start Time: 21-22. 

ConvertDurationToHours: 50. 

ConvertHoursToDuration: 41, 48. 

Copy: 71, 80. 



counter: 56, 71, 74. 

create : 45. 

CreateDeadlineFirstSchedule: 32, 53. 

CreateNewStepList: 31, 49 . 

CreateS cheduleRecord : 34, 57, 70. 

cur: 45, 47-48. 

Current: 38, 53, 62-64, 66, 68-71, 76, 

78, 84, 86-87, 90. 
dailyhours: 41, 48, 50. 
data-file: 41, 49. 

data2-file: 41, 45. 

D Current: 89-90. 

Deadline: 18, 21-22, 49-50, 66, 69-70. 

DEADLINE: 70. 

DeadTime: 49, 51. 

Deadtime: 50. 

debug: 41, 64, 66, 68-69, 71, 76, 78, 
84, 87, 89. 
debugB: 41. 

Delete Current: 53, 64, 78, 84, 86, 89. 

deleted: 62-64. 

DeletedlnputList: 17, 25. 

DeletedlnputListl : 17. 

DeletedlnputQueue: 25, 54, 64, 86. 

DeletedReadyList: 19, 25. 

DeletedReadyListl : 19 . 

DeletedReady Queue: 25, 54, 78, 84. 

Delete Matching: 84. 

Designer: 48, 57. 

Designer Matrix: 33, 35, 37-39, 52, 58, 

66, 70-71, 90. 
designermatrix : 53. 

Developer: 34, 57. 

diag-ready- queue: 72, 81-82. 

diag.sched: 72, 81-82. 
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diagstep: 72, 81-82. 

Display : 42-44, 47, 64. 

Display Calendar Record : 22. 

Display Element: 16-22. 

Display ScheduleRecord : 21. 

Display StepRecord : 16-20, 71, 84, 87. 

do-alternate: 49. 

do-verbose : 71-73, 81. 

Dsize: 84, 86-87, 89-90. 

Dummy : 70. 

dur: 47-48, 50-51. 

Duration : 47, 51. 

DurationToCalendarTime : 48. 

DurationtoCalendarTime : 48. 

EarliestStarttime: 62, 66. 

EarliestStartTime : 49-50, 62, 66, 68, 70. 

Early Time: 50-51. 

Earlytime: 49-50. 

eat: 53. 

EAT: 53. 

ElementType: 16-22. 

eniLof-file: 49. 

EstimatedDuration: 49, 66, 70. 

Exception: 24. 

ExpLevel: 49, 66, 70. 

F-Sched : 39, 71, 74, 80, 89. 

Fsched: 81. 

FALSE: 41, 62, 70. 

False: 53, 66. 

false: 41, 49, 62-63, 73, 82. 

FEAS: 38, 70. 

FeasFactor: 24, 74. 

feasible : 66. 

FEASIBLE: 37, 41. 

Feasible: 53, 71, 90. 

Feasiblel : 71, 90. 

file-type: 41. 

FinalSchedule: 25, 71. 

Finish: 38, 70. 

finish: 70. 

finish-t: 36, 62. 

FinishTime: 48, 57, 71, 90. 

Finishtime: 48. 



found: 71. 

FOUND: 41, 53, 62. 

Found: 39, 53, 71, 84, 86, 89. 

Generic-list: 16-22. 

Generic-List: 12. 

generic-map -pkg: 12. 

genericseLpkg: 12. 

get: 49. 

get-capability: 49. 

get-date: 49. 

get-developer-name: 70. 

get-line: 46, 49. 

GetCurrent: 48, 53, 62-63, 66, 87. 
getCurrent: 45. 

getfset: 49. 

getNext: 45. 

GetNext: 48, 53, 63, 66, 87. 

GetNth: 76, 78, 84, 86, 89. 

i: 45, 48, 52, 53, 62, 66, 71, 87. 

IN: 71. 

in-degree: 36, 60. 

in- file : 49. 

InDegree: 49, 53, 62, 64, 87. 

Indegree : 64. 

InList: 36, 62-64, 80, 83, 90. 
input: 45-46, 49. 

INPUT-LIST: 61. 

InputList: 16, 25-26, 31, 36, 39, 42, 

49, 62, 71, 90. 

InputListl : 16 . 

InsertlnOrder : 48, 53, 64, 78, 84, 86. 

integer: 55. 

is-qualified: 58. 

IsEmpty: 71. 

IsEqual: 18. 

Kntr: 53. 

kntr: 55, 62-63, 66-67. 
last: 58. 

length: 52, 58, 90. 
level: 58. 

LEVEL: 35, 58. 

LevelMinmum: 35, 58, 66, 70. 

levelminmum: 58. 
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List: 16-22. 

ListSize : 45, 48, 53, 62, 66, 71, 74, 76, 
84, 86-87, 89. 
m: 58 . 

MakeEmpty: 48-49, 54, 83. 

map : 34-35, 49, 57-58. 

MAT: 71, 80, 90. 

MATRIX: 35, 37-39, 52, 58, 66, 70- 
71, 80. 

matrix: 52, 58, 90. 

max-recursion: 23, 53, 72. 

member: 62, 87. 

min: 58, 66, 68. 

MIN: 70. 

mr: 32, 53. 

myonum: 66-67. 

Myopic-Num: 66-67. 

naLio: 49, 68-69, 71, 76, 81. 

natset: 49, 62, 87-88. 

natural: 23-24, 32-36, 38, 41, 45, 47, 53, 

56-58, 62, 66, 70, 73, 75, 77, 88, 90. 
new-line: 71. 

NoFeasibleScheduleFound: 24, 74. 

noqualifieddevelopers : 58-59. 

NRaD: 41, 48, 50. 

num-developers : 32, 53. 

open: 49. 

OrigSize: 71, 73, 76. 

Origsize: 76. 

out-file: 45. 

POSITIVE: 33. 

Predecessor : 62. 

Predecessors : 49. 

Print AllCalendar Records: 29, 47. 

Print AllScheduleRecords : 28, 44, 71, 81. 

Print AllStepRecords : 26, 27, 42, 43, 

71, 81. 

Priority: 49. 

Procedure : 32, 53. 

put: 68-69, 71, 76, 81, 84, 87. 

put-Line: 66, 84. 

put_line : 45-46, 49, 53, 64, 68-69, 71, 

76, 78, 81, 84, 87, 89. 



APPENDIX A §93 

Queue: 36-37, 62, 64, 66, 80, 83, 90. 
R-QUEUE: 81. 

R-Queue: 39, 71, 74, 76, 78, 80, 84. 

ReadyList : 18, 25, 27, 36-37, 39, 43, 

62, 66, 71, 90. 

ReadyListl : 18. 

ReadyQueue: 18-22, 25, 53-54, 62. 

Rec: 34, 36, 57, 62. 
recursion-level: 23, 64, 71-72, 79, 81, 

84, 86. 

Recursion-Level: 78. 

recursionlevel: 64, 84, 86. 

Recur sionLev el: 19-20, 78. 

RelnitializeMatrix : 52, 53. 

Rewind: 48, 53, 62, 66, 87. 

rewind: 45. 

S-ID: 34, 57. 

S-LEVEL: 34, 57. 

S-List: 39, 71, 74, 80-81, 86-87. 
SaveAllS cheduleRecords : 30, 45 . 

SaveScheduleRecord : 45. 

Sch: 38, 70. 

Sched: 80, 83, 90. 

SchedPrims: 12. 

schedtools: 12. 

schedtools.adb : 12. 

schedtools. ads : 12. 

Schedule: 25, 53-54. 

ScheduleList : 21, 25, 28-30, 38-39, 

44-45, 47, 70-71, 90. 

ScheduleListl : 21. 

ScheduleRecord : 21, 34, 45, 47, 57, 70, 90. 

ScheduleRecordHeading : 44,71. 

set: 62, 88. 

size: 45, 47-49, 62. 

sr: 49-50. 

StartTime: 41, 48-50, 57. 

StepID: 41, 49-50, 57, 70. 

Stepld: 48-49, 62, 68, 87. 

StepLevel: 48, 57. 

StepList: 25, 53. 

StepRecord: 16-22, 36, 38, 49, 53, 62, 

66, 70, 90. 
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StepRecordHeading : 42-43. 

Strongly Feasible: 37, 53, 66, 71. 

Success: 84-85. 

Successors : 49, 62, 87. 

system dependencies: 91. 

temp: 66, 69-70. 

tempi : 70. 

test-io-pkg: 12, 71. 

Text-IO: 12. 

Time: 41, 51. 

Time-0 f : 49. 

TIME1 : 34, 57. 

TIMES : 34, 57. 

TotSize : 74-75. 

tracking : 56. 

true: 64, 72. 

TRUE: 41, 70, 90. 

True: 53, 66, 71. 

Update Current: 62, 87. 

Use : 12. 

Used: 56. 

ustring: 34, 57. 

U string: 45, 49. 

Ustrings: 12. 

ustrings: 12. 

WorkHours: 41. 

yrcap : 49. 
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( Compute myopic number 67) Used in section 66. 

( Convert calendar times to absolute times 50 ) Used in section 49. 

(Convert ScheduleList to CalendarList 48) Used in section 47. 

( Copy linked lists and the designer matrix onto the stack 80 ) Used in section 71. 

( Debug code set 1 68 ) Used in section 66. 

( Debug code set 2 69 ) Used in section 66. 

(Delete appropriate R_Queue record 78) Used in section 71. 

( Do diagnostics 81 ) Used in section 80. 

( Free up local linked lists 83 ) Used in section 71. 

(Get appropriate R-Queue record 76) Used in section 71. 

( Get next record 63 ) Used in section 62. 

( Get output file name 46 ) Used in section 45. 

(Initialize the lists for intensive list-processing 54 ) Used in section 53. 

(Instantiate generics 16, 17, 18, 19, 20, 21, 22 ) Used in section 12. 

( Move record from input list to ready list 64) Used in section 62. 

( Package boiler-plate 12 ) Used in section 10. 

( Procedures and Tasks in schedtools 42, 43, 44, 45, 47, 49, 52, 53, 57, 58, 62, 66, 70, 71 ) 

Used in section 12. 

( Reset InDegree 87 ) Used in sections 84 and 86. 

( Restore F-Sched 89 ) Used in section 83. 

( Restore R-Queue 84 ) Used in section 83. 

( Restore S-List 86 ) Used in section 83. 

(Specification of procedures visible from schedtools 26, 27, 28, 29, 30, 31, 32, 34, 35, 36, 37, 38, 
39 ) Used in section 12. 

( Specification of types and variables visible from schedtools 23, 24, 25, 33, 59) 

Used in section 12. 

( Update backtrack counter 74 ) Used in section 71. 

( Update recursion stuff again 79 ) Used in section 71. 

( Update some recursion stuff 72 ) Used in section 71. 

( Variables local to Branch AndBound 73, 75, 77, 82, 85, 88, 90 ) Used in section 71. 

( Variables local to CreateNewStepList 51 ) Used in section 49. 

(Variables local to schedtools 41, 55, 56 ) Used in section 12. 
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1. Introduction. Here is the Ada code for utilites used in Salah Badr’s scheduler 
program. His program was written by him May 25, 1993. It was translated by John Evans 
of NRaD into Donald Knuth’s WEB format for literate programming. To compile and link 
the code in its present format you will need the Ada version of the WEB tool. 

It is available on-line via the world-wide-web at URL: 

http:/ / white.nosc.mil/~evansjr/hterate/ 



2. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
see the paper Literate Programming , by Donald Knuth in The Computer Journal, Vol 27, 
No. 2, 1984; or the book Weaving a Program: Literate Programming in WEB by Wayne 
Sewell, Van Nostrand Reinhold, 1989. Another good source of information is the Usenet 
group comp. programming. literate. It has information on new tools and Frequently Asked 
Questions (FAQs). 

3. Since the original AWEB package was written for Ada ’83, it does not properly format 
new Ada ’95 keywords protected and private . We remedy using the web format 
commands below. 

format protected = procedure 
format private = procedure 

4. As a way of explanation, each “Module” withing angle brackets (< >) is expanded 

somewhere further down in the document. The trading number you see within the brackets 
is where you can find this expansion. This provides a type of PDL (program descriptor 
language) for your program and greatly aids modularity and readability. It is also a highly 
effective method of top-down programming. The first module here is expanded further 
down, and contains most of the structure in standard Ada packages. 

( Package boiler-plate 5 ) 
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5. Schedule Primitives. 

( Package boiler-plate 5 ) = 

output to file schedprims . ads 

with generic-set jpkg -, 
with genericjmap-pkg ; 
with text Jo-, 
use text Jo ; 
with testJo-pkg; 
use testJo.pkg ; 
with Ada. Calendar-, 
use Ada. calendar ; 
with capability, 
use capability, 
with ustrings ; 
use ustrings ; 
package schedprims is 
{ Instantiate generics 9 ) 

(Specification of types and variables visible from schedprims 6) 
( Specification of procedures visible from schedprims 11 ) 
end schedprims ; 

output to file schedprims .adb 

with testJo-pkg-, 
with calyr ; 
use calyr ; 

package body schedprims is 

( Variables local to schedprims 25 ) 

( Procedures and Tasks in schedprims 26 ) 
end schedprims ; 

This code is used in section 4. 
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6. I make this a tagged record so that I can extend it in other packages that inherit this 
one. 

( Specification of types and variables visible from schedprims 6 ) = 
type StepRecord is tagged record StepID : natural ; 

Deadline : natural <— 0; 

Priority : natural ; 

EstimatedDuration : natural <— 0; 

Earliest StartTime : natural <— 0; 

ExpLevel : cap^map ,map\ 

Successors : nat^set.set ; 

Predecessors : natset.set ; 

InDegree : natural <— 0; 

RecursionLevel : natural <— 0; 
end record; 

See also sections 7 and 8. 

This code is used in section 5. 



7. 

( Specification of types and variables visible from schedprims 6 ) += 
type ScheduleRecord is 
record 

StepID : natural ; 

StartTime : natural ; 

FinishTime : natural ; 

Designer : ustring ; 

StepLevel : cap.map .map\ 

RecursionLevel : natural <— 0; 
end record; 



8 . 

( Specification of types and variables visible from schedprims 6 ) += 
type Calendar Record is 
record 

StepID : natural ; 

StartTime : Time ; 

FinishTime : Time ; 

Designer : ustring ; 

StepLevel : cap^map .map\ 
end record; 
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9. Here is the specification for generics. 

{ Instantiate generics 9 ) = 

package natset is new genericset-pkg (natural , 5); 

{ Instantiate instances of the generic map package. } 
package nat-map is new generic .map jpkg (key =» natural , result => natural ); 
package set-map is new generic -map jpkg (key =>• natural , result =£> natset .set)- 
package exp-map is new generic-mapjpkg(key =$> natural , result => ExpertiseLevel ); 

See also section 10. 

This code is used in section 5. 



10. Here is the specification for generics. 

( Instantiate generics 9 ) += 

package natJio is new integer Jio (natural); 

procedure putset is new natset .generic_put\ 

procedure getset is new natset .generic. input; 

procedure getfset is new natset .generic-file -input] 

package enu.io is new textJo .EN\JMERAT\ON-\0(ExpertiseLevel); 

11. This function is used to compare the ID of Step Records 

( Specification of procedures visible from schedprims 11 ) = 
function CompareID(Ll ,L2 : StepRecord )return Boolean ; 

See also sections 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, and 23. 

This code is used in section 5. 

12. This function is used to compare the ID of Step Records 

( Specification of procedures visible from schedprims ll } += 
function IsEqual(Ll , L2 : StepRecord)return Boolean ; 

13. This function is used to compare the Deadline of StepRecords 

( Specification of procedures visible from schedprims 11 ) += 

function CompareDeadLine(Ll , L2 : Step Record )ret urn Boolean ; 

14. This function is used to compare the Recursion of StepRecords 

( Specification of procedures visible from schedprims 11 ) += 

function CompareRecursionLevel(Ll ,L2 : StepRecord )return Boolean ; 

15. This function is used to compare the StartTime of StepRecords 

( Specification of procedures visible from schedprims 11 ) += 

function Compare StartTime [Ll , L2 : Schedule Record )ret urn Boolean ; 
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16. This function is used to compare the StartTime of StepRecords 

{ Specification of procedures visible from schedprims 11 ) += 

function CompareStartTime(Ll ,L2 : Calendar Record) return Boolean-, 

17. Printing a atep heading line before printing any records. 

( Specification of procedures visible from schedprims 11 ) += 
procedure StepRecordHeading ; 

18. Display a record given its LOCATION in the fist. 

{ Specification of procedures visible from schedprims 11 ) += 
procedure Display Step Record (rec : in StepRecord ); 

19. Printing a schedule heading line before printing any record. 

( Specification of procedures visible from schedprims ll ) += 
procedure ScheduleRecordHeading ; 

20. Printing a schedule heading line before printing any record. 

{ Specification of procedures visible from schedprims 11 ) += 
procedure CalendarRecordHeading ; 

21. display a record given its LOCATION in the list. 

( Specification of procedures visible from schedprims 11 ) += 

procedure Display ScheduleRecord (Current : in Schedule Record)] 



22 . 

( Specification of procedures visible from schedprims 11 ) += 

procedure SaveS cheduleRecord (Current : in ScheduleRecord]fd : file-type)] 

23. display a record given its LOCATION in the list. 

( Specification of procedures visible from schedprims ll } += 

procedure Display Calendar Record (Current : in Calendar Record)] 
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24. Schedule Primitives Body. 



25. 

( Variables local to schedprims 25 ) = 
debug : boolean *— false] 
debug2 : boolean <— false] 

This code is used in section 5. 



26. 

{ Procedures and Tasks in schedprims 26 } = 

function CompareID(Ll ,L2 : Step Record )return Boolean is 
begin 

if LI .Stepld < L2. Stepld then 
return True] 
else 

return False] 
end if; 

end ComparelD ] 

See also sections 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, and 38. 

This code is used in section 5. 



27. Stepld’s are suppose to be unique. 

( Procedures and Tasks in schedprims 26 ) += 

function IsEqual(Ll , L2 : Step Record )return Boolean is 
begin 

if debug2 then 

put("Ll .Stepld u = u "); nat-io .put (LI .Stepld , 1); put(" . u "); 
put ("L2 .StepId u = u M ); nat-io .put(L2 .Stepld, 1); put-line (" .u")i 
end if; 

if Ll .Stepld = L2. Stepld then 
return True] 
else 

return False] 
end if; 
end IsEqual] 
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28 . 

{ Procedures and Tasks in schedprims 26 ) += 

function CompareDeadline(Ll , L2 : Step Record) return Boolean is 
answer : boolean ; 

A, B : natural ; 
begin 

A <— LI . Deadline ; B <— L2 .Deadline] 
if debug then 

put("Ll .Deadline u = u "); nat-io .put(A)] putJine{" . u "); 
put ("L2 .Deadline u = u "); natAo ,put(B)\ putJine{" . u "); 
end if; 

if A < B then 

answer <— True ; 
else 

answer <— false ; 

end if; 
if debug then 

pu<("CompeureDeadline>u" ); 
if answer then 

nat-io .put(A)] p«t(" L |isijLESS L jthen L j" ); nat.io .put(B)] putJine(" . U M ); 
else 

naLio .put(A)] put(" u is u NOT u LESS u then u "); naLio .put(B)] putJine {" . u "); 

end if; 
end if; 

return answer ; 
end Compare Dead line ; 
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29. 

(Procedures and Tasks in schedprims 26 ) += 

function CompareRecursionLevel(Ll , L2 : StepRecord ) return Boolean is 
answer : boolean ; 

A,B : natural ; 
begin 

A +— LI .RecursionLevel ; B *— L2 .RecursionLevel) 
if A < B then 
answer *— True ; 
else 

answer <— false] 

end if; 
if debug then 

puJ("CompareRecursionLevel> u " ); 
if answer then 

nat-io .put (A)) pui("uis u LESS u then u "); naLio .put(B)) putJine{" .|_i")i 
else 

nat-io .put(A)] ptii(" LI is u NOT L jLESS L1 then L |"); nat-io .put(B)] put-line (" . u ")\ 
end if; 
end if; 

return answer ; 
end CompareRecursionLevel ; 



30. 

(Procedures and Tasks in schedprims 26) += 

function GompareStartTime[Ll ,L2 : ScheduleRecord ) return Boolean is 
begin 

if Ll .StartTime < L2 .StartTime then 
return True ; 
else 

return False ; 
end if; 

end CompareStartTime ; 
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31. 

(Procedures and Tasks in schedprims 26) += 

function Compare St art Time (Ll , L2 : Calendar Record) return Boolean is 
begin 

if LI .StartTime < L2 .StartTime then 
return True ; 
else 

return False ; 
end if; 

end Compare StartTime ; 

32. Printing a step record heading line before printing any records. 

(Procedures and Tasks in schedprims 26) += 
procedure StepRecordHeading is 
begin 

<ezUo.pu<( ,, STEP^IDuuDEADLINEuuPR.IOR.ITYuuPREDECEuuuSUCCESS uu E.LEVELuuIN>DEGREE , |; 
tez^_^o.pw^( ,, uuP'ECURSION' , ); text-io .new-line] 

text-io .put ( M ~ uuu uuu uu uuuu uu uu 'Di 

text-io .put(” uu M ); text-io .new-line ; 

end StepRecordHeading ; 

33. Display a record given its LOCATION in the list. 

(Procedures and Tasks in schedprims 26) += 

procedure Display StepRecord (rec : in StepRecord ) is 
begin 

text-io .set-Col( 4); test-io-pkg .put(rec .Stepld)] text-io .set-Col( 12); 
test-io-pkg . put(rec . Deadline ); text-io .set-col (23)] test-io-pkg .put(rec .Priority ); 
text-io .seLcol( 31); putset(rec . Predecessors ); text-io ,set-Col( 41); 
putset(rec. Successors ); text-io .seLcol( 49); print- capabilities (rec .ExpLevel)] 
text-io .set-Col( 61); test-io-pkg .put (rec .InDegree)] text-io .set-col (72); 
test-io-pkg .put (rec .Recur sionLevel)] text-io .new-line] 
end Display StepRecord ; 

34. Printing a schedule heading line before printing any record. 

( Procedures and Tasks in schedprims 26 ) += 
procedure ScheduleRecordHeading is 
begin 

text-io .pKt( M ID u START_TIME u FINISH_TIME U uS_LEVEL uulJ uuuuuuuuDEVEOPER n ); 
text-io .new-line ; 

text-io .put( n u u uu uuuuuuuuuuu M ); 

text-io .new-line ; 
end ScheduleRecordHeading ; 
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35. Printing a schedule heading line before printing any record. 

{ Procedures and Tasks in schedprims 26 ) += 
procedure CalendarRecordHeading is 
begin 

text-io .put("ID u START_TIME u FINISH_TIME uu S_LEVEL U uuuuuuuuuuDEVEGPER" ); 
text-io .new-line] 

text-10 .put ( 11 u U UU ~ ~ ~ ~UUUUUUUUUULI 11 )] 

text-io .new-line ; 
end CalendarRecordHeading ; 

36. Display a record given its LOCATION in the list. 

{ Procedures and Tasks in schedprims 26 ) += 

procedure Display ScheduleRecord (Current : in ScheduleRecord) is 
begin 

text-io .set-col( 1); nat-io .put(Current .StepID , 1); text-io .jeLco/(10); 
nat-io .put(Current.StartTime, 1); texLio .seLcol( 20); 
nat-io .put ( Current .FinishTime , 1); text-io .set_col( 35); 
print-capabilities ( Current .Step Level ) ; text-io .put ( " u " ) ; 
text-io .put(S( Current .Designer))] text-io .new-line ; 
end Display ScheduleRecord ; 

37. Display a record given its LOCATION in the list. 

{ Procedures and Tasks in schedprims 26 ) += 

procedure SaveScheduleRecord (Current : in ScheduleRecord \fd : file-type) is 
package Nat-io is new Integer-lo (Natural)] 
use Nat-io] 
begin 

text-io .set- col (fd ,\)] put(fd, Current. StepID ,1); text-io .set- col (fd , 10); 
put(fd , Current. StartTime,!)] text-io .seLcol(fd , 20); 
put(fd, Current. FinishTime ,1); text-io .set-col(fd , 35); 

print- capabilities (fd , Current .Step Lev el)] put(fd,"u')] put(fd, Current. Designer)] 
text-io .newJine(fd)] 
end SaveScheduleRecord ] 
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38. Display a record given its LOCATION in the list. 

(Procedures and Tasks in schedprims 26) += 

procedure Display Calendar Record [Current : in Calendar Record) is 
begin 

text-io .set-col (2); test-io-pkg .put ( Current. StepID ); text-io ..seLco/(10); 
calyr .print-date (Current .StartTime); texLio .seLcol( 25); 
calyr .print-date ( Current .FinishTime ); text-io .aeLco/(40); 
print-capabilities (Current .StepLevel)', text-io .put (" ULJ "); 
text-io .put (S (Current . Designer )); text-io .new-line ; 
end Display Calendar Record ; 



69 



SYSTEM-DEPENDENT CHANGES 



APPENDIX B §39 

39. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

40. RCS Keywords. 

$RCSfile: schedprims.aweb,v 
$ Revision: 1.4 
$Date: 1997/08/22 23:14:45 
$Author: evansjr 

$Id: schedprims.aweb,v 1.4 1997/08/22 23:14:45 evansjr Exp evansjr 

$Locker: evansjr 
$State: Exp 
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41. Index. Here is a cross-reference table for the MAIN program. All modules in which 
an identifier is used are listed with that identifier, except that reserved words are indexed 
only when they appear in format definitions, and the appearances of identifiers in module 
names are not indexed. Underlined entries of subprograms and packages correspond to 
sections where this entity is specified, whereas entries in italic type correspond to the 
section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



Ada: 5. 


FinishTime: 7-8, 36-38 


answer : 28-29. 


generic-file-input: 10. 


boolean : 25, 28-29. 


generic-input: 10. 


Boolean : 11-16, 26-31. 


generic-map-pkg: 5, 9. 


Calendar : 5. 


generic-put: 10. 


calendar : 5. 


genericset-pkg: 5, 9. 


Calendar Record: 8, 16, 23, 31, 38. 


getset: 10. 


CalendarRecordHeading : 20, 35. 


getfset: 10. 


calyr: 5, 38. 


ID: 11-12. 


cap -.map: 6-8. 


InDegree: 6, 33. 


capability: 5. 


integer-io: 10. 


Compare Deadline : 28. 


Integer-Io: 37. 


Compare DeadLine : 13. 


IsEqual : 12, 27. 


ComparelD : 11, 26. 


key: 9. 


CompareRecursionLevel: 14, 29. 


LI: 11-16, 26-31. 


CompareStartTime: 15, 16, 30, 31. 


L2: 11-16, 26-31. 


Current: 21-23, 36-38. 


map: 6-8. 


Deadline: 6, 13, 28, 33. 


nat-io: 10, 27-29, 36. 


debug: 25, 28-29. 


Nat-Io : 37. 


debug2 : 25, 27. 


naLmap : 9. 


Designer: 7-8, 36-38. 


natset: 6, 9, 10. 


Display Calendar Record : 23. 38. 


natural : 6-10, 28-29. 


Display S cheduleRecord : 21, 36. 


Natural : 37. 


Display StepRecord : 18, 33. 


new-line: 32-38. 


EarliestStartTime: 6. 


Predecessors : 6, 33. 


enu-io : 10. 


print-capabilities : 33, 3( 


ENUMERATION JO: 10. 


print-date: 38. 


EstimatedDuration: 6. 


Priority: 6, 33. 


exp-map : 9. 


private: 3. 


Expertise Lev el: 9-10. 


procedure: 3. 


ExpLevel: 6, 33. 


protected: 3. 


False : 26-27, 30-31. 


put: 27-29, 32-38. 


false: 25, 28-29. 


put-line: 27-29. 


fd: 22, 37. 


putset: 10, 33. 


file-type : 22, 37. 


rec: 18, 33. 
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Recursion : 14. 

RecursionLevel : 6-7, 29, 33. 

result: 9. 

SaveS cheduleRecord : 22, 37 . 

schedprims: 5. 

schedprims.adb : 5. 

schedprims . ads : 5. 

S cheduleRecord : 7, 15, 21-22, 30, 36-37. 

S cheduleRecordH eading : 19, 34* 

set: 6, 9. 

set-col: 33, 36-38. 

seLmap: 9. 

StartTime: 7-8, 15-16, 30-31, 36-38. 

StepID: 6-8, 36-38. 

Stepld : 26-27, 33. 

Step Level: 7-8, 36-38. 

StepRecord: 6, 11-14, 18, 26-29, 33. 

Step RecordH eading : 17, 32 . 

StepRecords : 11-16. 

Successors : 6, 33. 

system dependencies: 39. 

tagged: 6. 

tesLio-pkg : 5, 33, 38. 

text-io: 5, 10, 32—38. 

7jtwc * 8. 

True: 26-31. 

ustring: 7-8. 

ustrings: 5. 
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( Instantiate generics 9, 10 ) Used in section 5. 

( Package boiler-plate 5 ) Used in section 4. 

( Procedures and Tasks in schedprims 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38 ) 

Used in section 5. 

(Specification of procedures visible from schedprims 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
22, 23 ) Used in section 5. 

( Specification of types and variables visible from schedprims 6, 7, 8 ) Used in section 5. 
(Variables local to schedprims 25) Used in section 5. 
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1. Introduction. Here is the Ada code for Salah Badr’s scheduler program. It was 
written by him May 25, 1993. Here it has been translated to Donald Knuth’s WEB format 
for literate programming. To compile and link the code in its present format you will need 
the Ada version of the WEB tool. 

It is available on-line via the world- wide- web at URL: 

http://white.nosc.mil/'~evansjr/literate/ 



2. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
see the paper Literate Programming, by Donald Knuth in The Computer Journal, Vol 27, 
No. 2, 1984; or the book Weaving a Program: Literate Programming in WEB by Wayne 
Sewell, Van Nostrand Reinhold, 1989. Another good source of information is the Usenet 
group comp. programming. literate. It has information on new tools and Frequently Asked 
Questions (FAQs). 

3. The program consists of several packages that are declared right now; each of these 
packages and either the specification and the body of the packages are sent to a separate 
file. The main program itself is declared later. (Since the original AWEB package was 
written for Ada ’83, it does not properly format new Ada ’95 keywords protected and 
private . We remedy using the web format commands below. 

format protected = procedure 
format private = procedure 

4. As a way of explanation, each “Module” within angle brackets (< >) is expanded 

somewhere further down in the document. The trailing number you see within the brackets 
is where you can find this expansion. This provides a type of PDL (program descriptor 
language) for your program and greatly aids modularity and readability. It is also a highly 
effective method of top-down programming. 
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6. (Note: The following format is used by all the packages. We write the top-level code, 
in macro- level descriptions, and it gets expanded into code further down. This way you 
can write small, easily understood modules. It also lets you declare and describe variables 
and types where you need them.) 

output to file main.adb 

pragma suppress (all-checks)] 

with SchedTools ; 

with scheduler-, 

use scheduler ; 

with text Jo ; 

use text Jo-, 

with capability ; 

use capability, 

with ustrings ; 

use ustrings ; 

procedure main is (Instantiate generic packages 8 )( Variables local to main 9) 

begin 

loop 

begin 

SCHEDULER-MENU-, get(SELECTOR)-, skip-line-, 
case SELECTOR is 
when 1 =>• 

( Create new step list 10 ) 
when 2 => 

( Read in developer list 12 ) 
when 3 => 

( Schedule steps according to their deadlines 14 ) 
when 4 => 

( Print all steps in the ready queue 15 ) 
when 5 => 

( Print all step records 19 ) 
when 6 => 

( Print fined schedule 16 ) 
when 7 => 

( Save final schedule 17 ) 
when 8 =>■ 

( Print calendar schedule 18 ) 
when 9 =*> 

( Exit the program to the system 20 ) 

when others =>• 

( Exception handling for selector case 21 ) 
end case; 
exception 
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when storage-error =>■ 

("You u have u a u storage u error. "); 
put ( Your u level u of u recursionijis u "); nat-io .put (recursion-level)' 
put-line (". u "); 
when Data-Error =>■ 

put-line ( M Value u enteredunot u in u proper u raiige . U uPlease u try u again . " ); 

New -line ; Ship -Line] 

when SchedTools .NoFeasibleScheduleFound =» 

pui_/ine("Unable u to u find u feasible u schedule. uu Need u to u iiicrease u laxity. '1 

New -line] 

when NoD evelopers =>■ 

put-line ( No u developers u to u schedule u tasks u with . uLiPleasSutryijagain . 'B; 
New -line] ’ 

end; 

end loop; 
end main] 

7. As a way of explanation, each “Module” withing angle brackets (< >) is expanded 

somewhere further down in the document. The trailing number you see within the brackets 
is where you can find this expansion. This provides a type of PDL (program descriptor 
language) for your program and greatly aids modularity and readability. It is also a highly 
effective method of top-down programming. The first module here is expanded further 
down, and contains most of the structure in standard Ada packages. 

{Package boiler-plate 22) 



8 . 

(Instantiate generic packages 8) = 
package nat-io is new integer-io (natural)] 
use nat-io] 

This code is used in section 6. 



( Variables local to main 9 ) = 
type selector-type is new natural range 1 . . 9; 
selector : selector-type <— 1; 

package seLio is new integer-io (selector-type)] 
use seLio] 

See also sections 11 and 13. 

This code is used in section 6. 
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10 . This routine has been modified to read in a file and build up the linked list of “steps.” 

( Create new step list 10 ) = 
if num-developers > 0 then 

MakeNewStepList (num-developers ); 
else 

raise NoDevelopers ; 

end if; 

This code is used in section 6. 



11 . 

{ Variables local to main 9 ) += 

NoDevelopers : exception; 

12 . 

( Read in developer list 12 ) = 

put-line ( M Please u en.ter u developer u f ile u name: u "); 
get-line (infile ); 

get-developers (S(infile))] num-developers *— get-num.developers', 
This code is used in section 6. 

13 . 

( Variables local to main 9 ) += 
infile : ustring ; 

num-developers : natural *— 0; 



14 . 

( Schedule steps according to their deadlines 14 ) = 

PutJme("SchedulinguSteps u according u to u their u deadlines . "); 
MakeDeadlineFirstSchedule (max-recursion , num-developers ); 

This code is used in section 6. 



15 . 

{ Print all steps in the ready queue 15 ) = 
PrintReady Queue ; 

This code is used in section 6. 

16 . 

( Print final schedule 16 ) = 
PrintFinalSchedule ; 

This code is used in section 6. 
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17 . 

( Save final schedule 17 ) = 

SaveFinalSchedule ; 

This code is used in section 6. 

18 . 

( Print calendar schedule 18 ) = 

PrintC alendar Schedule ; 

This code is used in section 6. 

19 . 

{ Print all step records 19 } = 
newJine ; PrintStepList ; 

This code is used in section 6. 

20 . 

{ Exit the program to the system 20 ) = 

pu<("Maximumurecursion L |level u is L j ,, ); nat Jo .put (max.recursion)', putJine(" . u ")> 
put("Cnrrent u recursion u level LJ is u " ); natJo .put(recur$ionJevel)\ putJine(" . u "); 
put("thank u you u . . . . u Bye u . . .Bye"); newJine; exit; 

This code is used in section 6. 



21 . 

{ Exception handling for selector case 21 ) = 

put{" U B AD u CH0 ICE . U PLEASE U TRY U AGAI N " ) ; newJine ; 

This code is used in section 6. 
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22. Scheduler specification. 

{ Package boiler-plate 22 ) = 
output to file scheduler. ads 

with generic set-pkg ; 
with generic jmap^pkg ; 
with genericJist ; 
with schedprims ; 
use schedprims ; 
with schedtools ; 
use schedtools; 
with TEXTJO; 
use TEXTJO; 
with test-io-pkg; 
use test-io-pkg; 
package scheduler is 

( Specification of types and variables visible from scheduler 23 ) 
(Specification of procedures visible from scheduler 24) 
end scheduler; 

output to file scheduler .adb 

with unchecked-deallocation; 
package body scheduler is 

( Procedures and Tasks in scheduler 33 ) 
end scheduler; 

This code is used in section 7. 

23. Here are variables global to the recursion. 

( Specification of types and variables visible from scheduler 23 } = 
recursion-level : natural <— 0; 
max-recursion : natural <— 0; 

This code is used in section 22. 

24. Creating new step. 

(Specification of procedures visible from scheduler 24) = 

Procedure MakeNewStepList(num-developers : natural ); 

See also sections 25, 26, 27, 28, 29, 30, and 31. 

This code is used in section 22. 

25. Creating new step. 

{ Specification of procedures visible from scheduler 24 ) += 

Procedure MakeDeadlineFirstSchedule(maX-recursion : in out natural ; 
num-dev elopers : natural ); 
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26. 

( Specification of procedures visible from scheduler 24 ) += 
procedure SCHEDULER-MENU ; 



27 . 

( Specification of procedures visible from scheduler 24 ) += 
procedure PrintReady Queue] 

28 . 

( Specification of procedures visible from scheduler 24 ) += 
procedure PrintFinalSchedule ; 



29 . 

{ Specification of procedures visible from scheduler 24 ) += 
procedure SaveFinalSchedule ; 



30 . 

{ Specification of procedures visible from scheduler 24 ) += 
procedure PrintCalendar Schedule ; 

31 . 

( Specification of procedures visible from scheduler 24 ) += 
procedure PrintStepList ; 
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32. Scheduler Body. 



SCHEDULER BODY 



33. Creating new step. 

(Procedures and Tasks in scheduler 33) = 

Procedure MakeNewStepList(num-developers : natural) is 

begin 

CreateNewStepList(StepList ); 
end MaheNew Step List ; 

See also sections 34, 35, 36, 37, 38, 39, and 40. 

This code is used in section 22. 



34* 

( Procedures and Tasks in scheduler 33 ) += 

Procedure MakeDeadLineFirstSchedule(maz-recursion : in out natural ; 
num^developers : natural) is 

begin 

pu<_/me("Start u of u CreateDeadlineFirstSchedule. " ); 

CreateD eadlineFirstS chedule^max-recursion , num developers ); 
put_/me(*'End u of u CreateDeadlineFirstSchedule . " ); 
end MakeDeadLineFirstSchedule ; 
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35. DISPLAY THE MAIN MENU. 

(Procedures and Tasks in scheduler 33 } += 
procedure SCHEDULER-MENU is 
begin 

new-line ; seLcol( 25); pu/("MAIN u MENU"); new-line' set-col( 25); 

put{" "); new-line (2); 

set-col(5)', put{" [l] u Read u in u step u list"); 

new-line; 

set-col( 5); put{" [2] u Read u in u developer u list"); 
newAine ; 

set-Col( 5); put(" [3] u schedule u steps u using u BrauichAndBound"); 

new-line', 

set-col( 5); ptt<(" [4] u Print u ready u queue" ); 

new-line; 

set.col(5); put(" [5] u Print u step u list"); 

new-line; 

set-col( 5); put{" [6] u Print u final u schedule"); 

newJine-, 

seLcol( 5); put{" [7] u Save u final u schedule" ); 

new-line', 

set-col( 5); put ( " [8] u Print u Calendar u schedule"); 

new-line; 

seLcol( 5); put(" [9] u Quit"); neu;_/ine(3); je/_co/(5); 
put ("Enter u the u number u of u your u choice u : uu " ); 
end SCHEDULER-MENU ; 



36. 

( Procedures and Tasks in scheduler 33 ) += 
procedure PrintFinalSchedule is 
begin 

Print AllS chedule Records ( Schedule ) ; 
end PrintFinalSchedule ; 

37. 

( Procedures and Tasks in scheduler 33 ) += 
procedure SaveFinalS chedule is 
begin 

Save AllS chedule Re cords ( Schedule ); 
end SaveFinalS chedule ; 
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38 . 

( Procedures and Tasks in scheduler 33 ) += 
procedure PrintC alendarS chedule is 
begin 

Print AllC alendar Records ( Schedule ); 
end PrintC alendarS chedule ; 



39 . 

{ Procedures and Tasks in scheduler 33 ) += 
procedure PrintReady Queue is 
begin 

Print AllStep Records (Ready Queue ); 
end PrintReady Queue-, 



40 . 

{ Procedures and Tasks in scheduler 33 ) += 
procedure PrintStepList is 
begin 

Print AllStepRecords (StepList)-, 
end PrintStepList ; 
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41. Continuous Time to Calendar Time Translator. The purpose of this routine 
is to take the output of the scheduler and translate the continuous time fields ( StartTime 
and FinishTime) to calendar dates. 

output to file contocal.adb 

pragma suppress (alLchecks)-, 

with textAo ; 

use text-io ; 

with getopt ; 

use getopt ; 

with Ustrings ; 

use Ustrings ; 

with Ada .Calendar ; 

use Ada. Calendar’, 

with calyr-, 

use calyr’, 

with capability, 

use capability, 

procedure ConToCal is 

{ Variables local to ConToCal 45 ) 
package booLio is new enumerationAo (boolean)’, 
use booLio ; 
begin 

(Get parameters to ConToCal 43) 

( Open files 51 ) 

(Iterate through input file 53) end ConToCal ; 

42. The command syntax is as follows: 

contocal [-nrad < boolean >] [-start < startdate >] infile outfile 



43. The -nrad option is by default false, but when set to true will create a schedule that 
respects NRaD off-fridays. An example invocation coule be: 

contocal -nrad true -start 07/03/97+00 infile outfile 

If no start is given then the default is the same as the example. 

(Get parameters to ConToCal 43) = 

( Get nrad 44 ) 

( Get start date 46 ) 

( Get input file 48 ) 

( Get output file 50 ) 

This code is used in section 41. 
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44. 

( Get nrad 44 ) = 

if option-present (t/("-nrad")) then 

get-option (U("-nrad"), param ); get(S(param ), nrad , Last ); 
else 

nrad <— false ; 

end if; 

This code is used in section 43. 

45. 

( Variables local to ConToCal 45 ) = 
param : U string] 

Last : positive ; 
nrad : boolean ; 

See also sections 47, 49, 52, 55, 56, and 58. 

This code is used in section 41. 



46. 

( Get start date 46 ) = 

if option-present ([//"-start")) then 

get-option(U(" -start"), param)] StartDate <— get-date (param)] 
else 

StartDate <— Time- 0/(1997, 7, 3, 0.0); 

end if; 

This code is used in section 43. 

47. 

(Variables local to ConToCal 45) += 

StartDate : Time ; 

48. 

( Get input file 48 ) = 

if name-present ( 1) then 
g et-name (infile , 1); 
else 

raise nofilename] 

end if; 

This code is used in section 43. 
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49 . 

( Variables local to ConToCal 45 ) += 
nofilename : exception; 
infile , out file : U string \ 



50 . 

{ Get output file 50 ) = 
if name-present (2) then 
get^name ( outfile , 2); 
else 

raise nofilename ; 
end if; 

This code is used in section 43. 



51 . 

( Open files 51 ) = 

open (data, file, in. file , S (infile )); create (data2- file, out. file, S(outfile))’, 
This code is used in section 41. 

52 . 

{ Variables local to ConToCal 45 ) += 
data-file, data2-file : file-type ; 

53 . 

( Iterate through input file 53 ) = 
while -i En<L Of- File {data- file) loop 
( Read in record 54 ) 

( Do time translations 57 ) 

( Write out new record 59 ) 
end loop; 

This code is used in section 41. 
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54. A typical input file would look like the following: 
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14 


24 



The second to last column is the start time and the last column is the end time. 
{ Read in record 54 ) = 

kntr <— kntr + 1 ; put("Reading u in u record u " ); put(kntr ); puLline(" . u "); 
get (data, file, stepid ); get(data.file , Start)] get(data.file , Finish)] 
get.capability ( data.file , ExpLevel ); getJine ( data.fi.le , Developer ); 

This code is used in section 53. 

55. 

( Variables local to ConToCal 45 ) += 

type ExpertiseLevel is (low, medium, high); 
stepid : natural ; 

ExpLevel : cap^map .map; 

Developer : ustring ; 
start, finish : natural ; 
kntr : natural 4— 0 ; 



(Variables local to ConToCal 45) += 

package expAo is new enumeration-io (ExpertiseLevel)] 
use expAo ; 

package natAo is new integerAo (natural); 
use naLio ; 

57. 

( Do time translations 57 ) = 

dur 4— ConvertHoursTo Duration (Start); 

StartTime 4— DurationTo Calendar Time (StartD ate, dailyhours , dur , NRaD); 
dur 4— ConvertHoursToDuration(Finish); 

FinishTime 4— DurationTo C alendar Time (StartD ate , dailyhours , dur, NRaD ); 

This code is used in section 53. 
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58 . 

( Variables local to ConToCal 45 ) += 
dur : Duration ; 

StartTime, FinishTime : Time ; 

dailyhours : WorkHours <— (ConvertHoursToDuration(8), ConvertHoursToDuration(8), 
ConvertHours ToDuration( 8), ConvertHoursToDuration (8), 

ConvertEours ToDuration (8)); 



59 . 

( Write out new record 59 ) = 

s et-col ( data2-file , 1 ); put( data2-file , stepid , 1 ); set.col( data2-file ,10); 
print-date ( data2-file , Start Time)', s et-col ( data2-file , 25); 
print-date ( data2-file , FinishTime ); set-col ( data2-file , 40); 
print-capabilities (data2-file , ExpLevel ); put (data2- file , "u n )’> 
put (data2- file , Developer)-, new-line(data2-file)', 

This code is used in section 53. 
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60. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 



61. 



RCS Keywords. 



$RCSfile: main.aweb,v 
$Revision: 1.5 
$Date: 1997/08/22 23:14:45 
$Author: evansjr 

$Id: main.aweb,v 1.5 1997/08/22 23:14:45 evansjr Exp evansjr 

$Locker: evansjr 
$State: Exp 
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62. Index. Here is a cross-reference table for the MAIN program. All modules in which 
an identifier is used are listed with that identifier, except that reserved words are indexed 
only when they appear in format definitions, and the appearances of identifiers in module 
names are not indexed. Underlined entries of subprograms and packages correspond to 
sections where this entity is specified, whereas entries in italic type correspond to the 
section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



Ada : 41. 
alLchecks: 6, 41. 

booLio: 41. 

boolean : 41, 45. 

Calendar: 41. 

calyr : 41. 

cap.map : 55. 

capability: 6, 41. 

ConToCal: 41. 

contocal . adb : 41. 

ConvertHours ToDuration : 57-58. 

create: 51. 

CreateDeadlineFirstSchedule : 34. 

CreateNewStepList : 33. 

dailyhours : 57-58. 

Data-Error: 6. 

datafile: 51-54. 

data2-file: 51-52, 59. 

Developer: 54-55, 59. 

dur: 57-58. 

Duration: 58. 

DurationToCalendarTime : 57. 

EncLOf.File: 53. 

enumeration-io : 41, 56. 

exp-io : 56 . 

ExpertiseLevel: 55, 56. 

ExpLevel: 54-55, 59. 

false: 44. 

file-type : 52. 

Finish : 54, 57. 

finish: 55. 

FinishTime: 41, 57-59. 
generic-list: 22. 

generic-map-pkg : 22. 

generics et-pkg : 22. 



get: 6, 44, 54. 

get. cap ability : 54. 

get-date: 46. 

get-developers : 12. 

get-line: 12, 54. 

get-name: 48, 50. 

get-num-dev elopers : 12. 

get-option: 44, 46. 

getopt: 41. 

htg h : 55 . 

in-file: 51. 

infile : 12-13, 48-49, 51. 

integer.io: 8-9, 56. 

kntr: 54-55. 

Last: 44-45. 
low: 55. 

main: 6. 

main, adb: 6. 

MakeDeadlineFirstSchedule: 14, 25. 

MakeDeadLineFirstSchedule : 34. 

MakeNewStepList: 10, 24, 33. 

map: 55. 

max-recursion: 14, 20, 23, 25, 34. 

medium: 55. 

name-present: 48, 50. 

nat-io: 6, 8, 20, 56 . 

natural: 8-9, 13, 23-25, 33-34, 55-56. 

new-line: 19-21, 35, 59. 

New-line: 6. 

NoDevelopers: 6, 10-11. 

N oFeasibleS cheduleFound : 6. 

nofilename: 48-50. 

nrad: 44-45. 

NRaD: 57. 

num-dev elopers : 10, 12-14, 24-25, 33-34. 
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INDEX 



open: 51. 

option-present : 44, 46. 

out-file: 51. 

outfile: 49-51. 
param: 44-46. 

positive : 45. 

print- capabilities : 59. 

print-date: 59. 

Print AllCalendar Records : 38. 

Print AllS cheduleRecords : 36. 

PrintAllStep Records : 39—40. 

PrintCalendar Schedule: 18, 30, 38. 

PrintFinalSchedule: 16, 28, 36 . 

PrintReady Queue : 15, 27, 39 . 

PrintStepList: 19, 31, 40 . 

private: 3. 

Procedure : 24-25, 33-34. 

procedure: 3. 

protected: 3. 

put: 6, 20-21, 35, 54, 59. 

Put-line : 14. 

put-line: 6, 12, 20, 34, 54. 

ReadyQueue: 39. 

recursion-level: 6, 20, 23. 

Save AllS cheduleRecords : 37. 

SaveFinalSchedule: 17, 29, 37 . 

schedprims : 22. 

SchedTools: 6. 

schedtools : 22. 

Schedule: 36-38. 

scheduler : 6, 22. 

scheduler. adb : 22. 

scheduler .ads : 22. 

SCHED ULER-MENU : 6 , 26, M- 
seLio: 9. 

selector: 9. 

SELECTOR: 6. 
selector-type: 9. 

set-col: 35, 59. 

skip-line: 6. 

Skip-Line: 6. 

Start: 54, 57. 

start: 55. 



StartDate: 46-47, 57. 

StartTime : 41, 57-59. 

stepid: 54-55, 59. 

StepList: 33, 40. 

storage-error: 6. 

suppress : 6, 41. 

system dependencies: 60. 

test-io-pkg: 22. 

TEXTJO: 22. 

text-io: 6, 41. 

Time: 47, 58. 

Time-Of: 46. 

true: 43. 

unchecked-deallocation: 22. 

ustring: 13, 55. 

U string: 45, 49. 

V strings: 41. 

ustrings: 6. 

WorkHours : 58. 
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( Create new step list 10 ) Used in section 6. 

( Do time translations 57 ) Used in section 53. 

( Exception handling for selector case 21 ) Used in section 6. 

( Exit the program to the system 20 ) Used in section 6. 

( Get input file 48 ) Used in section 43. 

( Get nrad 44 ) Used in section 43. 

( Get output file 50 ) Used in section 43. 

(Get parameters to ConToCal 43) Used in section 41. 

( Get start date 46 ) Used in section 43. 

( Instantiate generic packages 8 ) Used in section 6. 

( Iterate through input file 53 ) Used in section 41. 

( Open files 51 ) Used in section 41. 

( Package boiler-plate 22 ) Used in section 7. 

( Print all step records 19 ) Used in section 6. 

( Print all steps in the ready queue 15 ) Used in section 6. 

( Print calendar schedule 18 ) Used in section 6. 

( Print final schedule 16 ) Used in section 6. 

( Procedures and Tasks in scheduler 33, 34, 35, 36, 37, 38, 39, 40 ) Used in section 22. 

( Read in developer fist 12 ) Used in section 6. 

( Read in record 54 ) Used in section 53. 

( Save final schedule 17 ) Used in section 6. 

( Schedule steps according to their deadlines 14 ) Used in section 6. 

( Specification of procedures visible from scheduler 24, 25, 26, 27, 28, 29, 30, 31 ) 

Used in section 22. 

( Specification of types and variables visible from scheduler 23 ) Used in section 22. 
( Variables local to ConToCal 45, 47, 49, 52, 55, 56, 58 ) Used in section 41. 

( Variables local to main 9, 11, 13 ) Used in section 6. 

( Write out new record 59 ) Used in section 53. 
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1. Introduction. The scheduler designed and implemented by Salah Badr uses lists 
extensively. However, it has specific routines for each list used by the scheduler. This is 
redundant, as well as error prone. In my design to eliminate some large data structures 
that are slightly modified and duplicated in a very recursive and space consuming manner, 
I have decided to use additional linked lists to keep track of additions and deletions at 
each level of recursion. By keeping track of just the “changes” This will turn an N squared 
space problem into one that is linear. (This is shown to be true, later.) 

2. So since linked lists are used extensively, it pays to have a single generic routine. 
The implementation is thus hidden from the user. This allows “information-hiding,” and 
increased modularity, 

3. This code is written using Donald Knuth’s WEB paradigm for literate programming. 
To compile and link the code in its present format you will need the Ada version of the 
WEB tool. 

It is available on-line via the world-wide-web at URL: 

http: / / white.nosc.mil/ ~evansjr /literate/ 



4. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
see the paper Literate Programming , by Donald Knuth in The Computer Journal, Vol 27, 
No. 2, 1984; or the book Weaving a Program: Literate Programming in WEB by Wayne 
Sewell, Van Nostrand Reinhold, 1989. Another good source of information is the Usenet 
group comp. programming. literate. It has information on new tools and Frequently Asked 
Questions (FAQs). 

5. The program consists of several packages that are declared right now; each of these 
packages and either the specification and the body of the packages are sent to a separate 
file. The main program itself is declared later. (Since the original AWEB package was 
written for Ada ’83, it does not properly format new Ada ’95 keywords protected and 
private . We remedy using the web format commands below. 

format protected = procedure 
format private = procedure 

6. As a way of explanation, each “Module” withing angle brackets (< >) is expanded 

somewhere further down in the document. The trailing number you see within the brackets 
is where you can find this expansion. It is top-down in appearance, and in actual fact. 

7. All the modules follow the same, top-down format. I will group all the boiler-plate into 
one module, for the compiler, but you will see it with the packages, as they are described. 

( Package boiler-plate 8 ) 
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8. List Specification. This specification is a modification of the one presented in the 
book Ada 95 Problem Solving and Program Design, by Michael Feldman and Elliot B. 
KofFman. The implementation was left as an exercise for the student. 

{ Package boiler-plate 8 ) = 

output to file generic-list .ads 

with TEXT.IO; 
use TEXT.IO; 
generic 

type ElementType is private ; {Any nonlimited type will do} 
with procedure DisplayElement(Item : IN ElementType)', 
with function "<"(2/1 ,L2 : ElementType ) return Boolean', 
with function "="(L1 ,L2 : ElementType ) return Boolean is <>; 
package generic-list is 

(Specification of types and variables visible from generic -list 9 )( Specification of 
procedures visible from generic-list 12} private 
( Specification of private types and variables in generic-list 10 } 
end generic-list; 

output to file generic.list .adb 

( Packages needed by generic-list body 32 ) 
package body generic-list is 

(Variables local to generic-list 30 ) 

( Procedures and Tasks in generic-list 33 ) 
end generic-list] 

This code is used in section 7. 



( Specification of types and variables visible from generic-list 9 ) = 
type list is limited private ; 

ListEmpty : exception; 

This code is used in section 8. 



10 . 

( Specification of private types and variables in generic-list 10 ) 
type ListNode] type ListPtr is access ListNode ; 
type ListNode is 
record 

Element : ElementType', 

Next : ListPtr ; 
end record; 

See also section 11. 

This code is used in section 8. 
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11. Added Size field to original code. 

( Specification of private types and variables in generic-list 10 ) += 
type List is 
record 

Size : Natural ; 

Head : ListPtr ; 

Tail : ListPtr ; 

Current : ListPtr ; 

Previous : ListPtr ; 
end record; 



12 . 

{ Specification of procedures visible from generic-list 12 ) = 
function ListSize(L : in Ziat)return natural ; 

See also sections 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, and 28. 
This code is used in section 8. 

13. Returns True if L is empty, False otherwise. 

( Specification of procedures visible from generic-list 12 ) += 
function IsEmpty(L : IN List)RETURN Boolean ; 



14. 

Pre: Element is defined; L may be empty. 

Post: Element is inserted at the beginning of L. 

(Specification of procedures visible from generic-list 12) += 

procedure AddToFront(L : in out List] Element : in ElementType)] 



15. 

Pre: L is defined; L may be empty. 

Post: returns a complete copy of the list L. 

Raises: ListEmpty if the list is empty before the retrieval. 

( Specification of procedures visible from generic-list 12 ) += 
function Retrieve Front (L : in List) return ElementType] 



16. 

Pre: L is defined; L may be empty. 

Post: The first node of L is removed. 

Raises: ListEmpty if the list is empty before the removal. 

( Specification of procedures visible from generic-list 12 ) += 
procedure RemoveFront(L : in out List)] 
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17 . 

Pre: L is defined. 

Post: L is empty. 

{ Specification of procedures visible from generic-list 12 ) += 
procedure MakeEmpty(L : in out List); 



18 . 

Pre: Element is defined; L may be empty. 

Post: Element is appended to the end of L. 

( Specification of procedures visible from generic-list 12 ) += 

procedure AddToEnd(L : in out List; Element : in ElementType); 



19 . 

Pre: Source may be empty. 

Post: Returns a complete copy of Source in Target. 

( Specification of procedures visible from generic-list 12 ) += 
procedure Copy (Source : in List; Target : out List); 



20 . 

Pre: L may be empty. 

Post: displays the contents of L's Element fields, in the 

order in which they appear in L. 

{ Specification of procedures visible from generic-list 12 ) += 
procedure Display (L : IN List); 

21 . 

(Specification of procedures visible from generic-list 12) += 

procedure Ins ertln Order (L : in out List; Element : ElementType); 

22 . 

( Specification of procedures visible from generic-list 12 ) += 

procedure GetNext(L : in out List; Element : out ElementType); 

23 . 

( Specification of procedures visible from generic-list 12 ) += 
procedure DeleteCurrent(L : in out List); 

24 . 

( Specification of procedures visible from generic-list 12 ) += 

procedure DeleteMatching(L : in out List; Element : in ElementType; success : out 
boolean ); 
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25 . 

( Specification of procedures visible from genericJist 12 ) += 

procedure GetCurrent(L : in List] Element : out ElementType ); 

26 . 

( Specification of procedures visible from genericJist 12 ) += 

procedure UpdateCurrent[L : in List] Element : in ElementType)] 

27 . 

( Specification of procedures visible from genericJist 12 ) += 

procedure GetNth(L : in out List]N : in natural ; Element : out ElementType ); 

28 . 

( Specification of procedures visible from genericJist 12 ) += 
procedure Rewind (L : in out List)] 
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29. List Body. 



30. 

( Variables local to generic-list 30 ) = 
debug : boolean <— false ; 

See also section 31. 

This code is used in section 8. 



31. 

{ Variables local to generic-list 30 ) += 

procedure Dispose is new unchecked- deallocation (Object => ListNode, 
Name => ListPtr)-, 

package naLio is new integer-io (natural)-, 



32. 

{ Packages needed by generic-list body 32 ) = 
with unchecked-deallocation ; 
with U strings ; 
use Ustrings; 

This code is used in section 8. 



33. 

( Procedures and Tasks in generic-list 33 ) = 

function ListSize(L : in List ) return Natural is 
begin 

return L.Size-, 
end ListSize ; 

See also sections 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, and 49. 

This code is used in section 8. 

34. Returns True if L is empty, False otherwise. 

( Procedures and Tasks in generic-list 33 ) += 

function IsEmpty(L : IN List)RETURN Boolean is 
begin 

if ListSize (L) = 0 then 
return True-, 
else 

return False-, 
end if; 
end IsEmpty, 
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35 . 

Pre: Element is defined; L may be empty. 

Post: Element is inserted at the beginning of L. 

{ Procedures and Tasks in generic-list 33 ) += 

procedure AddToFront(L : in out List] Element : in ElementType) is 
Temp : ListPtr] 

begin 

Temp <— new ListNode ; Temp .all. Element *— Element] Temp .all. Next *— L.Head 
L.Head <— Temp] L.Size <— L.Size + 1; 
if L.Size = 1 then 
L.Tail < — L.Head] 
end if; 

end AddToFront] 



36 . 

Pre: L is defined; L may be empty. 

Post: returns a complete copy of the list L. 

Raises: ListEmpty if the list is empty before the retrieval. 

( Procedures and Tasks in generic-list 33 ) += 

function RetrieveFront(L : in £w<)return ElementType is 
Temp : ListPtr ; 
begin 

if L.Head = null then 
raise ListEmpty] 

else { L.Head points to a node; remove it } 

Temp «— L.Head] return Temp .Element] 

end if; 

end RetrieveFront] 
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37. 

Pre: L is defined; L may be empty. 

Post: The first node of L is removed. 

Raises: ListEmpty if the list is empty before the removal. 

( Procedures and Tasks in genericHist 33 ) += 
procedure RemoveFront (L : in out List) is 
Temp : ListPtr] 
begin 

if L.Head = null then 
raise ListEmpty ; 

else { L.Head points to a node; remove it } 

Temp <— L.Head ; L.Head <— L.Head. all. Next-, {jump around first node} 
Dispose (X =>■ Temp)] L.Size <— L.Size — 1; 

end if; 

end RemoveFront ; 



38. 

( Procedures and Tasks in generic-list 33 ) += 
procedure MakeEmpty(L : IN OUT List) is 
ptr : ListPtr ; 
begin 

While L.Head ^ null loop 
RemoveFront (L); 

end loop; 

L.Size <— 0; L.Tail <— null; 
end MakeEmpty, 
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39 . 

Pre: Element is defined; L may be empty. 

Post: Element is appended to the end of L. 

( Procedures and Tasks in generic-list 33 ) += 

procedure AddToEnd(L : IN OUT List; Element : IN ElementType ) is 
ptr : ListPtr] 
begin 

if debug then 

put("Ad.dToEnd> u Addingyto u end u ofijlist : u " ); Display Element (Element)', 
end if; 

if L.Head = null then 

L.Tail *— new ListN ode' (Element, null); L.Head <— L.TaiT, 
else 

ptr <— new ListN ode' (Element, null); L . Tail .all.next <— ptr; L.Tail <— ptr-, 

end if; 

L.Size <— L.Size + 1; 
end AddToEnd ; 



40 . 

Pre: Source may be empty. 

Post: Returns a complete copy of Source in Target. 

( Procedures and Tasks in generic-list 33 ) += 

procedure Copy (Source : in List ; Target : out List) is 
ptr : listptr ; 
begin 

ptr <— Source. head', MakeEmpty (Target); 

while ptr ^ null loop 

AddToEnd (Target, ptr .all. element)', ptr ptr. all.next-, 

end loop; 
end Copy, 
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41 . 

Pre: L may be empty. 

Post: displays the contents of L's Element fields, in the 
order in which they appear in L. 

( Procedures and Tasks in genericAist 33 ) += 
procedure Display (L : IN List) is 
ptr : ListPtr ; 
begin 

if debug then 

put-Line ("Display>" ); 
end if; 

ptr <— L.Head ; 
while ptr ^ null loop 

DisplayElement (ptr .all. Element)] ptr <— ptr .all. Next ; 
end loop; 
end Display, 
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42 . 

( Procedures and Tasks in genericAist 33 ) += 

procedure InsertInOrder(L : in out List] Element : ElementType) is 
Current : ListPtr ; 

Previous : ListPtr ; 

Temp : ListPtr ; 
begin 

if debug then 

put(" Insert InOrder>" ); puLLine ("Youruinputulistuis : u " ); display (L)] 
put( M Insert InOrder> " ); put-Line ( " Youruinputuelementuis : u " ); 
display element (Element)-, 

end if; 

if L.Head = null then 
AddToFront (L, Element)] 
elsif Element < L.Head .all.Element then 
AddToFront (L, Element)] 

elsif (L. Tail. all. Element < j Element)^/ (L.Size = 1) then 
AddToEnd (L, Element ); 
else 

if L.size = 1 then 

putAine ("Insert InOrder>uShould u not u be u here ! " ); raise ListEmpty ; 
end if; 

Temp +— new ListNode' (Element , null); Previous <— L.Head] 

Current <— Previous .all. next] 

while Current .all. element < Element loop 

Previous <— Current] Current «— Current .all. next] 
end loop; 

Temp .all. next <— Current] Previous .all. next <— Temp] L.Size <— L.Size +1; 

end if; 
if debug then 

put(" Insert InOrder> M ); put-Line ("Your u input u list u is u now: u "); display (L)] 
end if; 

end InsertlnOrder ] 
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43. Must be used with ListSize and Rewind or you will never know when you are at the 
end of the list. 

{ Procedures and Tasks in genericAist 33 ) += 

procedure GetNth(L : in out List]N : in natural] Element : out ElementType ) is 
begin 

if debug then 

put("GetNth> u Getting u " ); natAo.put(N , 1); put(" 'th u record u =>"); 
end if; 

if L.Head = null then 
raise ListEmpty] 
elsif N > L.Size then 
raise ListEmpty, 
elsif N = 1 then 

L. Current <— L.Head ; L. Previous <— L.Tail ; 
else 

Rewind ( L ); 

for i € 2 . . N loop 

L. Previous <— L. Current] L. Current <— L. Current. all. next] 
end loop; 
end if; 

Element <— L. Current. all. element] 
if debug then 

Display Element (Element)] 
end if; 
end GetNth] 

44. Must be used with ListSize and Rewind or you will never know when you are at the 
end of the list. 

(Procedures and Tasks in genericAist 33) += 

procedure GetCurrent(L : in List] Element : out ElementType) is 
begin 

if L.Head = null then 
raise ListEmpty] 
end if; 

Element «— L. Current. all. element] 
end GetCurrent] 



110 



LIST BODY 



§45 Appendix D 

45. Must be used with LiatSize and Rewind, or you will never know when you are at the 
end of the list. 

( Procedures and Tasks in generic-list 33 ) += 

procedure Update Current (L : in List] Element : in ElementType) is 
begin 

if L.Head = null then 
raise ListEmpty, 
end if; 

L. Current .all. element <— Element] 
end Update Current] 



46. 

( Procedures and Tasks in generic-list 33 ) += 
procedure DeleteCurrent(L : in out List) is 
Temp : ListPtr] 
begin 

if L.Head = null then 
raise ListEmpty] 
elsif L.Size = 1 then 

Temp 4— L. Current] L. Current *— null; L. Previous 4— null; L.Head <— null; 
L.Tail 4 — null; 
else 

Temp 4— L. Current] 

if L. Current = L.Tail then 

L. Previous .all. next *— L. Current. all. next; L. Current *— L.Head] 

L. Tail 4— L. Previous ; 
elsif L. Current = L.Head then 

L. Current 4— L. Current. all. Next] {jump around current node} 

L.Head 4— L. Current] 
else 

L. Previous .all. next 4— L. Current .all. next] L. Current 4— L. Current, all. Next] 
{jump around current node} 
end if; 
end if; 
if debug then 

put ( "Delet eCurrent >Delet ing=> " ); Display Element ( Temp .all .Element)] 
end if; 

Dispose (X => Temp)] L.Size 4— L.Size — 1; 
end Delete Current] 
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47. 

( Procedures and Tasks in generic-list 33 ) += 

procedure DeleteMatching(L : in out List] Element : in ElementType] success : out 
boolean) is 
kntr : natural] 

Current : ElementType] 
begin 

success <— false] 
if L.Head = null then 
raise ListEmpty] 
end if; 

Rewind (L)] kntr <— L.Size] 
for i € 1 . . kntr loop 
GetNext(L, Current)] 
if Current = Element then 

Delete Current (L)] success <— true] exit; 
end if; 
end loop; 

end DeleteMatching] 



48. 

(Procedures and Tasks in generic-list 33 ) += 
procedure Rewind (L : in out List) is 
begin 

L. Current <— L.Head] L. Previous <— L.Tail] 
end Rewind ; 

49. Must be used with ListSize and Rewind or you will never know when you are at the 

end of the list. 

( Procedures and Tasks in generic-list 33 ) += 

procedure GetNext(L : in out List] Element : out ElementType) is 
begin 

if L.Head = null then 
raise ListEmpty, 
elsif L. Current = L.Tail then 

L. Current *— L.Head] L. Previous <— L.Tail] 
else 

L. Previous < — L. Current] L. Current *— L. Current. all. next; 
end if; 

Element <— L. Current. all. element] 
end GetNext] 
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50. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

51. RCS Keywords. 

$RCSfile: list.aweb,v 
$Revision: 1.4 
$Date: 1997/08/06 16:54:30 
$ Author: evansjr 

$Id: list.aweb,v 1.4 1997/08/06 16:54:30 evansjr Exp evansjr 

$Locker: evansjr 
$State: Exp 
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52. Index. Here is a cross-reference table for the MAIN program. All modules in which 
an identifier is used are listed with that identifier, except that reserved words are indexed 
only when they appear in format definitions, and the appearances of identifiers in module 
names are not indexed. Underlined entries of subprograms and packages correspond to 
sections where this entity is specified, whereas entries in italic type correspond to the 
section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



AddToEnd : 18, 39, 40, 42. 
AddToFront: 14, 35, 42. 

boolean : 24, 30, 47. 

Boolean : 8, 13, 34. 

Copy : 19, 40 . 

Current : 11, 42-49. 

debug: 30, 39, 41-43, 46. 

DeleteCurrent: 23, 46, 47. 

DeleteMatching : 24, 47 . 

display : 42. 

Display : 20, 41 . 

Display Element: 8, 39, 41, 43, 46. 

display element: 42. 

Dispose: 31, 37, 46. 

element: 40, 42-45, 49. 

Element: 10, 14, 18, 20-22, 24-27, 

35-36, 39, 41-47, 49. 

ElementType: 8 , 10, 14-15, 18, 21-22, 

24-27, 35-36, 39, 42-45, 47, 49. 
False: 13, 34. 

false: 30, 47. 

generic-list: 8. 

generic_list .adb : 8. 

generic_list .ads : 8. 

GetCurrent: 25, 44 . 

GetNext: 22, 47, 49. 

GetNth: 27, 43. 

Head: 11, 35-39, 41-49. 

head: 40. 

i: 43, 47. 

IN: 8, 13, 20, 34, 38-39, 41. 

InsertlnOrder: 21, 42. 

integer-io: 31. 

Is Empty: 13, 34. 

Item: 8. 



kntr: 47. 

List: 11, 12-28, 33-49. 

list: 9. 

ListEmpty: 9, 15-16, 36-37, 42-47, 49. 

ListNode: 10, 31, 35, 39, 42. 

ListPtr: 10 , 11, 31, 35-39, 41-42, 46. 

listptr: 40. 

ListSize: 12, 33, 34, 43-45, 49. 

LI: 8. 

L2: 8. 

MakeEmpty: 17, 38, 40. 

Name: 31. 

nat-io : 31, 43. 

natural: 12, 27, 31, 43, 47. 

Natural: 11, 33. 

Next: 10, 35, 37, 41, 46. 
next: 39-40, 42-43, 46, 49. 

Object: 31. 

OUT: 38-39. 

Previous: 11, 42-43, 46, 48-49. 

private: 5. 

procedure: 5. 

protected: 5. 

ptr: 38-41. 

put: 39, 42-43, 46. 

put-Line : 41-42. 

put-line: 42. 

RemoveFront: 16, 37, 38. 

RetrieveFront: 15, 36 . 

RETURN: 13, 34. 

Rewind: 28, 43-45, 47, 48, 49. 

size : 42. 

Size : 11, 33, 35, 37-39, 42-43, 46-47. 
Source : 19, 40. 

success : 24, 47. 
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system dependencies: 50. 

Tail : 11, 35, 38-39, 42-43, 46, 48-49. 

Target: 19, 40. 

Temp: 35-37, 42, 46. 

TEXT.IO: 8. 

true: 47. 

True: 13, 34. 

uncheckecLdeallocation: 31-32. 

Update Current: 26, 45 . 

Ustrings : 32. 

While : 38. 

with: 8. 
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( Package boiler-plate 8 ) Used in section 7. 

( Packages needed by generic-list body 32 ) Used in section 8. 

( Procedures and Tasks in generic-list 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 
49 ) Used in section 8. 

{ Specification of private types and variables in generic-list 10, 11 ) Used in section 8. 

( Specification of procedures visible from generic-list 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 
23, 24, 25, 26, 27, 28 ) Used in section 8. 

( Specification of types and variables visible from generic-list 9 ) Used in section 8. 

( Variables local to generic-list 30, 31 ) Used in section 8. 
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1. Introduction. This package computes federal holidays, and off-fridays for NRaD. 
(We work five days one week, four the next — nine hours a day, except for Fridays.) The 
input is just the year. If you do not work the 5/4 weeks then there is a switch (-nps true) 
that you can use to turn it off. 

2. This is based on a C program calyr, written by Bob Hall of Nrad in the eighties. 
Bob was a brilliant, and prolific programmer at NRaD who retired in the early nineties. 
One of his programs msgs , formed the basis of Eudora , a popular mail tool for PC’s and 
Macintoshes, and now owned by Qualcomm. 

3. This program was written to work for dates after 1970. It should work till the year 
2099. (A year 3000 problem!) To test it out compile the driver program and run it with 
the following command line: 

main [-year <year>] [-nps <boolean>] 



For example: 



main -year 1993 -nps false 



4. This code is written using Donald Knuth’s WEB paradigm for literate programming. 
To compile and link the code in its present format you will need the Ada version of the 
WEB tool. 

It is available on-line via the world-wide-web at URL: 

http: / / white.nosc.mil / ~evansjr /literate / 

• P 

5. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
see the paper Literate Programming , by Donald Knuth in The Computer Journal, Vol 27, 
No. 2, 1984; or the book Weaving a Program: Literate Programming in WEB by Wayne 
Sewell, Van Nostrand Reinhold, 1989. Another good source of information is the Usenet 
group comp. programming. literate. It has information on new tools and Frequently Asked 
Questions (FAQs). 

6. The program consists of several packages that are declared right now; each of these 
packages and either the specification and the body of the packages are sent to a separate 
file. The main program itself is declared later. (Since the original AWEB package was 
written for Ada ’83, it does not properly format new Ada ’95 keywords protected and 
private . We remedy using the web format commands below. 

format protected = procedure 
format private = procedure 
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7. As a way of explanation, each “Module” withing angle brackets (< >) is expanded 

somewhere further down in the document. Consider it a high-level PDL (Program De- 
scriptor Language). The trailing number you see within the brackets is where you can find 
this expansion. It is top-down in appearance, and in actual fact. 

8. All the modules follow the same, top-down format. I will group all the boiler-plate into 
one module, for the compiler, but you will see it with the packages, as they are described. 

( Package boiler-plate 9 ) 
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9. Calyr Specification. 

( Package boiler-plate 9 ) = 
output to file calyr. ads 

with U strings ; 
use Ustrings ; 
with TEXT.IO; 
use TEXT.IO; 

with Ada .Command-Line ; 
use Ada .Command-Line] 
with Ada. Calendar] 
use Ada. Calendar] 
package calyr is 

{ Specification of types and variables visible from calyr 11 ) 
{ Specification of procedures visible from calyr 16 ) 
end calyr] 

output to file calyr. adb 

( Packages needed by calyr body 10 ) 
package body calyr is 
( Types local to calyr 57 ) 

( Variables local to calyr 33 ) 

( Local Procedures 59 ) 

( Procedures and Tasks in calyr 39 ) 
end calyr] 

This code is used in section 8. 



10 . 

(Packages needed by calyr body 10 ) = 
with text-io] 
use text-io ] 

See also section 32. 

This code is used in section 9. 



11 . 

(Specification of types and variables visible from calyr ll ) = 
subtype Hour-Number is integer range 0 . . 23; 
subtype Minute-Number is integer range 0 . . 59; 
subtype Second-Number is integer range 0 . . 59; 

See also sections 12, 13, 14, and 15. 

This code is used in section 9. 
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12. 

( Specification of types and variables visible from calyr ll ) += 
BadYear : Exception ; 

BadDay : Exception ; 

type fourarray is array (0 . . 3) of integer ; 
type threearray is array (0 . . 2) of integer ; 



13 . 

(Specification of types and variables visible from calyr 11 ) += 

type month is ( Jan , Feb, Mar , Apr ,May ,Jun, Jul, Aug , Sep , Oct, Nov , Dec ); 
type DayOfWeek is [Sun, Mon, Tue , Wed, Thu , Fri , Sat)] 

14 . 

( Specification of types and variables visible from calyr 11 ) += 
subtype WeekDay is DayofWeek range Mon .. Fri ; 



15 . 

( Specification of types and variables visible from calyr 11 ) += 
Type WorkHours is array ( WeekDay ) of Duration ; 



16 . 

( Specification of procedures visible from calyr 16 ) = 

procedure print-holiday s(yr : in Year. Number ; do.nps : in boolean)', 

See also sections 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, and 30. 

This code is used in section 9. 

17. Given a date (in Ada time format), hoLdy returns any special info about it. 



status return values: 0 


not a special day 


1 


a non- work holiday 


2 


observation of a non- work holiday 


3 


other special day (not non-work) 


4 


an off-Friday or Thursday 


di return values: di[0] 


weekday of holiday (0 to 6) 


dill] 


day identification index 


di[2] 


2: off-Friday; 1 : off-Thursday 
0: not an offday 



( Specification of procedures visible from calyr 16 ) += 

procedure hoLdy (yrdate : time\di : out threearray ; status : out integer ); 
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18. This function was taken from the book Numerical Recipes. It actually works on any 

year, not the artificial limit imposed by Ada type Year-Number (1901 . . 2099). 

( Specification of procedures visible from calyr 16 ) += 

function julian. day (Month : Month-Number] Day : Day-Number ; Year : Integer) return 
long-integer ; 

19. This procedure calculates the Month, Day, and Year when given the Julian-day . 

( Specification of procedures visible from calyr 16 ) += 

procedure caldate (Julian : Long-integer ; Month : out Month-Number ; Day : out 
Day-Number ; Year : out Integer ); 

20. Computes whether this is an off-day or a work-day. 

( Specification of procedures visible from calyr 16 ) += 

function Is WorkDay ( YrDate : Time] NRaD : boolean <— false] 
debugit : boolean false ) return boolean] 

21. Function aid computing new dates based on work hours. 

( Specification of procedures visible from calyr 16 ) += 

function DurationToCalendarTime(StartDate : Time] daily hours : WorkHours] 
hrs : Duration] NRaD : boolean ) return Time] 

22. Inverse of above. 

( Specification of procedures visible from calyr 16 ) += 

function CalendarTimeToDuration(StartDate : Time] daily hours : WorkHours] 
EndDate : Time] NRaD : boolean ) return Duration] 

23. 

( Specification of procedures visible from calyr 16 ) += 

function SameDay(Timel , Time2 : Time ) return boolean] 

24. 

( Specification of procedures visible from calyr 16 ) += 

function GetD ay Of Week (Today : Time )return DayOfWeek] 

25. Straightforward transformation. 

( Specification of procedures visible from calyr 16 ) += 

function ConvertHoursToDuration(hrs : natural ) return Duration] 

26. Inverse of previous. 

(Specification of procedures visible from calyr 16) += 

function ConvertDurationToHours(dur : Duration ) return natural] 
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27. 

( Specification of procedures visible from calyr 16 ) -f = 

Procedure Split (Seconds : Day-Duration] Hour : out Hour-Number] Minute : out 
Minute-Number ; Second : out Second-Number)] 



28. 

( Specification of procedures visible from calyr 16 ) += 
procedure print-date (date : time)] 
procedure print-date (outfile : file-type] date : time)] 



29. 

{ Specification of procedures visible from calyr 16 ) += 
function get-date (str : in {/string )ret urn Time] 
function get-date (infile : file-type )return Time] 

30. Adds one day to the input parameter. 

{ Specification of procedures visible from calyr 16 ) += 
function IncrementDay( YrDate : Time)return Time] 



124 



§31 APPENDIX E 
31. Calyr Body. 



CALYR BODY 



32. 

(Packages needed by calyr body 10 ) += 

with Ada .Strings .Unbounded ] Use Ada. Strings. Unbounded 1 , with Ustrings ; 
use Ustrings ; 

33. Number days in the month. 

(Variables local to calyr 33) = 

ndm : array ( Month-Number ) of natural <— (31,28,31,30,31,30,31,31,30,31,30,31); 

See also sections 34, 35, 36, 37, 38, 46, 48, 49, 50, 58, and 65. 

This code is used in section 9. 

34. Last day/previous month. 

( Variables local to calyr 33 ) += 

Idpm : array ( Month-Number ) of natural <— (0,31,59,90,120,151,181,212,243,273, 
304,334); 

35. List of holidays. 

( Variables local to calyr 33 ) += 

NumHolidays : constant natural <— 20; 

holidays : constant array (1 .. NumHolidays) of Ustring *— ([/("NewuYear 's u Day" ), 
[/("ML u King u Day"), U( "Presidents ' u Day"), [/("Memorial u Day" ), 

[/( " Independence u Day " ), U( "Labor u Day " ), U ( "Columbus u Day" ), 

[/("Veterans ' u Day " ), U( "Thanksgiving u Day" ), U ( "Christmas u Day" ), 
[/("Valentine 's u Day" ), [/("St u Patrick's u Day"), [/("Good u Friday"), 
[/("Easter"), [/("Mothers ' u Day" ), [/("Armed u Forces u Day"), [/("Flag u Day"), 
[/("Fathers ' u Day" ), [/("Halloween" ), U ("Election u Day" )); 
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36. Index of Holidays. 

( Variables local to calyr 33 ) += 

JNYD : constant integer <— 1; 

JMLK : constant integer <— 2; 

JPRS : constant integer *— 3; 

JMEM : constant integer <— 4; 

JIND : constant integer *— 5; 

JLAB : constant integer *— 6; 

JCOL : constant integer <— 7; 

JVET : constant integer <— 8; 

JTHX : constant integer <— 9; 

JCHR : constant integer <— 10; 

JVAL : constant integer ■*— 11; 

JSPT : constant integer *— 12; 

JGFR : constant integer *— 13; 

JEST : constant integer *— 14; 

JMOT : constant integer <— 15; 

JAFD : constant integer <— 16; 

JFLG : constant integer <— 17; 

JFAT : constant integer <— 18; 

JHAL : constant integer <— 19; 

JELC : constant integer <— 20; 

37. Index of something. 

( Variables local to calyr 33 ) += 

INYD : constant integer <— 0; {index for NEW YEAR’S DAY, etc. } 
IMLK : constant integer <— 1; 

IPRS : constant integer <— 1; 

IGFR : constant integer <— 1; 

IEST : constant integer *— 2; 

IMEM : constant integer «— 2; 

ICOL : constant integer *— 0; 

IVET : constant integer <— 1; 

IHAL : constant integer *— 2; 

IELC : constant integer «— 0; 
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38 . 

( Variables local to calyr 33 ) += 
debug : boolean *— false] 
debugB : boolean <— false] 
verbose : boolean <— true] 
nps : boolean <— false] 
already-leaped : boolean <— false] 
package int-io is new integer.io (integer)] 
use int-io] 



39 . 

( Procedures and Tasks in calyr 39 ) = 

procedure hoLdy(yrdate : time] di : out threearray ; status : out integer ) is 
(Types and Variables local to hoLdy 41 ) 
begin 

( Parse date 40 ) 

( Check if leap year 42 ) 

( Set year 43 ) 

( Set month 63 ) 

( Loop over holidays and OfF-Fridays 67 ) 
end hoLdy] 

See also sections 81, 88, 93, 101, 109, 118, 129, 131, 132, 133, 134, 136, 137, 139, 141, and 143. 
This code is used in section 9. 

40 . 

( Parse date 40 ) = 

Split(yrdate , Year , Month , Day , Seconds)] hmn <— Calyr .month 1 val (Month — 1); 
status <— 0; di(0) <— 0; dt(l) <— 0; di( 2) «— 0; 

This code is used in section 39. 

41 . 

(Types and Variables local to hoLdy 41 ) = 

Year : Year-Number ; 

Month : Month-Number ; 

Day : Day-Number ; 

Seconds : Day-Duration ; 
hmn : Calyr .Month] 

See also sections 45, 64, 68, and 71. 

This code is used in section 39. 
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42. Simple-minded check. Must later look up what to do at end of century. 

( Check if leap year 42 ) = 

if ((hear mod 4) = 0) A (-> already-leaped) then 

already-leaped. <— true ; ndm(calyr .month' pos (Feb) + 1) <— 29; 
for j G 3 . . 12 loop 

ldpm(j) *- ldpm(j) + 1; 
end loop; 
end if; 

This code is used in section 39. 

43. The datatype hoi must be modified based on the year. The following code does just 
that. 

( Set year 43 ) = 

(Calculate weekday of Jan 1. 44) 

( Calculate beginning date of 1st pay period in year 47 ) 

( Update ML King Day 51 ) 

(Update President’s Day 52) 

(Update Memorial Day 53) 

(Update Columbus Day 54) 

( Update Veteran’s Day 55 ) 

( Compute Easter 56 ) 

This code is used in section 39. 



44. 

(Calculate weekday of Jan 1 . 44) = 

jul := juliari-day{ 1,1, Tear); fdy *— DayOfWeek' val([jul + 1) mod 7); 
jul := julian-day (Month , Day , Tear); <fi(l) <— integer((jul + 1) mod?); 
This code is used in section 43. 

45. 

( Types and Variables local to hoLdy 41 ) += 
jul : long-integer ; 

46. Make global. 

( Variables local to calyr 33 ) += 
fdy : DayOfWeek\ 
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47. Funny C logic. Seems to work. 

( Calculate beginning date of 1st pay period in year 47 } = 
tYear <— Year — 1970; tmp <— (Year — 1) rem4; 
if tmp = 0 then 
tmp <— 1; 
else 

tmp <— 0; 

end if; 

bpp <— (11 — tYear — tmp — (tYear / 4)) rem 14; 
if bpp < 1 then 
bpp <— bpp + 14; 
end if; 

This code is used in section 43. 

48. Make global. 

(Variables local to calyr 33) += 
bpp : integer ; 
tYear : integer ; 
tmp : integer ; 



49. 

( Variables local to calyr 33 ) += 
type hoLtype is 
record 

dy : fourarray ; { Day of week or date of holiday } 

wn : fourarray ; { Week number (-1 ~l skip } 

fl : fourarray ; { 1/0 non- work/ work holiday } 
ix : fourarray ; { Index of holiday name } 

end record; 
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50. I know this is ugly, but it comes directly from C code. 

( Variables local to calyr 33 ) += 

hoi : array (Month) of hoLtype <— (((1, DayOfWeek 'pos (MON), —1,0), (0, 3, 0, 0), (1, 
1,0, 0), (JNYD , JMLK , 0, 0)), ((14, DayOfWeek 'pos (M ON), -1, 0), (0, 3, 0, 0), (0, 1, 
0,0), (JVAL,JPRS, 0,0)), ((17, 0,0,-l),(0,-l,-l,0),(0,0,0,0),(J5PT, JGFfl, 
JEST, 0)), ((0, 0, 0, — 1), (-1, — 1, -1, 0), (0, 0, 0, 0), (0, JGFR , JEST, 0)), 
((DayOfWeek 'pos (SUN ), DayOfWeek' pos (SAT), DayOfWeek 'pos (MON), -1), (2, 
3, 5, 0), (0, 0, 1, 0), (JMOT, JAFD,JMEM, 0)), ((14, DayOfWeek' pos (SUN ), -1,0), 

(0,Z,0,0),(0,0,0,0),(JFLG,JFAT,0,0)),((4,-1,0,0),(0,0,0,0),(1,0,0,0),(JIND, 

0,0,0)), ((—1,0, 0,0), (0, 0,0, 0), (0,0,0, 0), (0,0,0, 0)), ((DayOfWeek 'pos (MON), 
-1,0, 0), (1, 0, 0, 0), (1, 0, 0, 0), ( JLAB , 0, 0, 0)), ((DayOfWeek 'pos (MON), 
DayOfWeek' pos (MON ),Z1, -1), (2, -1,0, 0), (1, 1,0, 0), (JCOL,JVET , JHAL, 0)), 
((DayOfWeek 1 pos ( TUE), 11, DayOfWeek' pos ( THU), —1), (—1, 0,4,0), (0, 1, 1, 0), 
(JEL C , JVET, JTHX , 0)), ((25, - 1 , 0, 0), (0, 0,0, 0), (1,0, 0, 0), ( JCHR , 0, 0, 0))); 

51. ML King Day became federal holiday in 1986. 

( Update ML King Day 51 ) = 
if Year > 1985 then 

hol(JAN).wn(IMLK) <- 3; 
else 

hol(JAN).wn(IMLK) <- -1; 
end if; 

This code is used in section 43. 

52. President’s day is third Monday (after 1971). 

( Update President’s Day 52 ) = 

hol(Feb).dy(IPRS) <— DayOfWeek' pos (Mon); hol(Feb).wn(lPRS) *— 3; 
if (Year < 1971) then 

hol(Feb).dy(IPRS) <- 22; hol(Feb).wn(IPRS) 0; 

end if; 

This code is used in section 43. 



53. Memorial Day is last Monday in May. 

( Update Memorial Day 53 ) = 

hol(May).dy(IMEM) <— DayOfWeek' pos (Mon); hol(May).wn(IMEM) *— 5; 

This code is used in section 43. 
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54. Columbus Day is second Monday in October. Did not exist before 1971, I guess? 

{ Update Columbus Day 54 ) = 
hol(Oct).wn(ICOL ) <— 2; 
if Year < 1971 then 

hol(Oct).wn(ICOL) < 1; 

end if; 

This code is used in section 43. 

55. 

( Update Veteran’s Day 55 ) = 

hol(Oct).wn(IVET) +- -1; hol(Nov).wn(IVET) +- 0; 
if Year < 1978 then 

hol(Oct).wn(IVET ) +- 4; hol(Nov).wn(IVET) +- -1; 

end if; 

This code is used in section 43. 

56. Calls the function Easter. Also computes Good Friday. 

{ Compute Easter 56 ) = 

edt <— easter(Year)-, hol(edt.mn).dy(IEST ) <— edt.dt ; hol(edt.mn).wn(IEST ) <— 0; 
edt . dt ^ edt . dt 2 , 
if edt.dt < 1 then 

edt.dt <— edt.dt + ndm( 3); edt.mn <— Mar\ 

end if; 

hol(edt.mn).dy(IGFR) «— edt.dt ; hol(edt .mn).wn(IGFR) <— 0; 

This code is used in section 43. 



57 . 

( Types local to calyr 57 ) = 
type caldat is 
record 

mn : Month-, 
dt : integer-, 
end record; 

This code is used in section 9. 

58 . 

{ Variables local to calyr 33 ) += 
edt : caldat ; 
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59. Here is the function easter that returns the day and month Easter occurs for a given 
year. 

(Local Procedures 59) = 

function easter(Year : in Year_Number)return caldat is 
( Types and variables local to easter 60 ) 
begin 

fde «— ndm(l) + ndm{2)\ dt.dt <— pfm((Year — 1900) mod 19); 
if dt.dt < 0 then 

dt.mn <— Mar\ dt.dt * dt.dt ; 

else 

dt.mn <— Apr ; fde <— fde + ndm( 3); 

end if; 

( Compute weekday for Paschal Full Moon 62 ) 
return dt\ 
end easter ; 

This code is used in section 9. 

60. Here is the Paschal Full Moon table used to find Easter. 

( Types and variables local to easter 60 ) = 

pfm : constant array (0 .. 18) of integer «— (14, 3, —23, 11, —31, 18, 8, —28, 16,5, —25, 
13, 2, -22, 10, -30, 17, 7, -27); 

See also section 61. 

This code is used in section 59. 

61 . 

( Types and variables local to easter 60 ) += 
fde : integer ; 
dt : caldat ; 

62. Easter is the next Sunday following the Paschal Full Moon. 

( Compute weekday for Paschal Full Moon 62 ) = 

fde <— ( dt.dt + fde — (8 — DayOfWeek' pos (fdy))) rem7; 
if fde < 0 then 

fde <— (7 + fde ) rem 7; 

end if; 

dt.dt <- dt.dt + 7 -fde-, 

if dt.dt > ndm (month 1 pos [dt .run ) + 1) then 

dt.dt <— dt.dt — ndm^month* pos [dt.mn) + 1); dt.mn <— month* succ(dt .mn)\ 
end if; 

This code is used in section 59. 
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63. Used to determine off-fridays of month. Also, if November, figure out election day. 

( Set month 63 ) = 
declare 

Idm , ofr , ii , jj : integer ; 
begin 

ofr *— bpp — 2; 
if ofr < 1 then 
ofr <— ofr + 14; 

end if; 

Idm <— ldpm(Month ); ofr <— ofr + (Idm/ 14) * (14) — Idm ; 
if ofr < 0 then 
ofr <— ofr + 14; 

elsif ((Month > 1) A (ofr > 14)) then 
ofr <— ofr — 14; 

end if; 

ofrdy( 0) «- UN ST; ofrdy( 1) «- UNST ; ofrdy( 2) UNST; ofrdy( 3) UN ST; 

if ( Fear > 1979) then 
JJ <- 0; 

loop 

if (( Year ± 1982) V (Month ± 4) V (ofr f 2)) A (( Year ± 1980) V (Month ± 1)) 

then 

ofrdy (jj ) «- ofr; jj *- jj + 1; 

end if; 

ofr *— ofr + 14; exit when ofr > ndm(Month); 

end loop; 
end if; 

fdm *— (Idm — (7 — DayOfWeek' pos(fdy))) rem 7; 
if fdm < 0 then 

fdm <— (7 + fdm) rem 7; 

end if; 

( Figure out election day 66 ) 

end; 

This code is used in section 39. 



64. 

(Types and Variables local to hoLdy 41 ) += 
UNST : constant integer <— 64; 
jj : integer ; 
ofrdy : fourarray ; 
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65. Make global. 

( Variables local to calyr 33 ) += 
fdm : integer ; 



66 . 

( Figure out election day 66 ) = 

if ( hmn = Nov ) A (( Year rem 2) = 0) then 
ii *— hol(Nov).dy(IELC) — fdm + 1; 
if ii < 1 then 
ii *— ii + 7; 
end if; 

if ii < 2 then 

hol(Nov).wn(IELC ) <— 2; 
else 

hol(Nov).wn(IELC ) <— 1; 

end if; 
end if; 

This code is used in section 63. 



67. Main part of hoLdy . 

( Loop over holidays and Off- Fridays 67 ) = 

ii <— 0; jj <— 0; 

loop 

( Check for no more holidays 69 ) 
if ( hol(hmn).wn(ii ) > 0) then 

ho < — 0; ( Holiday with fixed week day or fixed date 70 ) 

( Exhaust any earlier off-Fridays 72 ) 

{ Check if off- Friday moved back to Thursday 73 ) 

{ Work, and normal and Sunday non- work, holiday 74 ) 

{ Monday/Friday extra day 75 ) 

{ Saturday non- work holiday 76 ) 
end if; 
ii «— ii + 1; 

{(ugly)) exit when (it > 3); 

exit when ((hol(hmn).dy (it) < 0) A (ofrdy(jj) = UNST )); 

end loop; 

( December processing 77 ) 

This code is used in section 39. 



68 . 

(Types and Variables local to hoLdy 41 ) += 
ii,ho : integer-, 
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69. 

( Check for no more holidays 69 ) = 
if hol(hmn).dy(ii ) < 0 then 

if (integer (Month) < 12) V (ofrdy(jj) < ndm( 12)) then 
if ofrdy(jj) — Day then 
di( 2) «- 2; 
if status = 0 then 
status +— 4; 
end if; 
end if; 

jj jj +1; goto ugly; 
else 
exit; 
end if; 
end if; 

This code is used in section 67. 
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70. 

( Holiday with fixed week day or fixed date 70 ) = 
if hoi (hmn).wn(ii) > 0 then 

dw <— hol(hmn).dy (it); date dw — fdm + 1; 
if date < 1 then 
date <— date + 7; 
end if; 

date «— date + (7 * (hol(hmn).wn(ii) — 1)); 
if date > ndm (Month) then {Takes care of Memorial Day} 
date <— date — 7; 

end if; 

else { Holiday with fixed date } 

date <— hol{hmn).dy (**); dw *— (date — (8 — fdm)) rem 7; 
if dw < 0 then 

dw <— (7 + dw) rem 7 ; 

end if; 

if hol(hmn).fl(ii ) > 0 then { Take care of weekend holidays } 
if dw = DayOfWeek'pos(Sun) then 
ho <— 1; 

elsif dw = Day Of Week' po a (Sat) then 

ho « 1; 

else 

ho 0; 

end if; 
end if; 
end if; 

This code is used in section 67. 



71. 

(Types and Variables local to hoLdy 41 ) += 
date, dw : integer ; 
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72. 

{ Exhaust any earlier off-Fridays 72 ) = 

while (( hol(hmn).fl(ii ) > 0) A (((ho > 0) A ofrdy(jj ) < date) V ((ho < 0) A (ofrdy(jj ) < 
( date — 1))))) V ((hol(hmn).fl(ii) = 0) A ( ofrdy(jj ) < date)) loop 
if ofrdy(jj) = Day then 
di ( 2 ) 4- 2 ; 
if status = 0 then 
status <— 4; 
end if; 
end if; 

jj + 1 ; 

end loop; 

This code is used in section 67. 



73. 

{ Check if off- Friday moved back to Thursday 73 ) = 

if (ofrdy(jj) > l)A(hol(hmn).fl(ii) > 0)A ((ofrdy(jj) — date)\/ (ofrdy(jj) = ( date + ho ))) 

then 

if ( ofrdy(jj ) — 1) = Day then 
di( 2 ) 4 - 1 ; 
if status = 0 then 
status 4— 4; 

end if; 
end if; 

jj *- jj + 1 ; 

end if; 

This code is used in section 67. 



74. 

( Work, and normal and Sunday non-work, holiday 74 ) = 
if (ho > 0) A (date = Day) then 

di( 0) 4— dw ; di(l) 4— hol(hmn).ix(ii)\ status <— 1 + 2 * (di(l)/ JVAL)- 

end if; 

This code is used in section 67. 



75. 

{ Monday/ Friday extra day 75) = 

if (ho / 0) A ((date + ho) > 0) A ((date + ho) = Day) then 
di(0) 4— dw 4- ho ; di(l) 4— hoi (hmn).ix (**); status +— 2; 

end if; 

This code is used in section 67. 
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{ Saturday non- work holiday 76 ) = 
if (ho < 0) A (date = Day ) then 

<fi(0) <— dw ; di( 1) <— hol(hmn).ix(ii)\ status <— 1; 

end if; 

This code is used in section 67. 



77. 

{ December processing 77 ) = 
if hmn — Dec then 

( Is first of next year a Friday or Saturday and this is an off- Friday? 78 ) 
( Weekday of December 31 79 ) 

(December 31 a Friday the observe Saturday, January 1st 80 ) end if; 
This code is used in section 67. 



78 . 

( Is first of next year a Friday or Saturday and this is an off- Friday? 78 ) = 
if jj ^ 0 then 

if ( ofrdy(jj ) = ndm( 12)) then 
tmp <— 1; 
else 

tmp <— 0; 

end if; 

if ((ofrdy (jj — 1) = (ndm(\2)—\Z))\/(ofrdy(jj) = ndm(12)))/\((ndm(12)—tmp) = Day) 
then 
di(2) <- 1; 

if status = 0 then 
status <— 4; 
end if; 
end if; 
end if; 

This code is used in section 77. 

79 . 

( Weekday of December 31 79 ) = 

dw <— (ndm(12) — (8 — fdm )) rem 7; 
if dw < 0 then 

dw <— (7 + dw) rem 7; 

end if; 

This code is used in section 77. 
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80 . 

(December 31 a Friday the observe Saturday, January 1st 80 ) = 
if (dw = Day 0 fWeek' pos(Fri)) A ndm( 12) = Day then 

di( 0) <— DayofWeek' pos(Fri); di(\) <— hol(Jan).ix(INYD ); status <— 2; 

end if; 

This code is used in section 77. 



81. 

( Procedures and Tasks in calyr 39 ) += 

procedure print-holidays (yr : in Year-Number] do-nps : in boolean ) is 
( Variables local to print-holidays 84 ) 
begin 

nps <— do-nps ; { Loop through months 82 ) 
end print-holidays ; 

82. Straightforward. 

( Loop through months 82 ) = 
for mon £ Jan . . Dec loop 
if -i verbose then 

put (month 1 image (mon))] put (">"); 

end if; 

( Loop through days of month 83 ) 
if -i verbose then 

put-line(" u ")] 

end if; 
end loop; 

This code is used in section 81. 
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83. 

( Loop through days of month 83 ) = 

for ii 6 1 .. (ndm(month' pos (mon) + 1)) loop 

hoLdy(Time-of (yr , month' pos ( mon ) + 1, ii, 0.0), di , status)-, 
if -i verbose then 
if ( status > 0) then 

put("day u =u")) P u t(ii, 1); put (" . uu statusy=y"); put (status ,1)-, 
put(" uu di u = u <"); 
for i <E 0 . . 2 loop 
put(di(i),i)-, 
if i < 2 then 

put 

end if; 
end loop; 
put-l tne("> u "); 
end if; 
else 

( Print out first day of month 85 ) 

( Print out holidays, as necessarily 87 ) 

end if; 
end loop; 

This code is used in section 82. 

84. 

( Variables local to print-holidays 84 ) = 
status : integer ; 
di : threearray ; 

See also section 86. 

This code is used in section 81. 



85. 

(Print out first day of month 85 ) = 
if ii — 1 then 

put (month' image (mon))-, put(ii, 3); put(" u "); hfdm <— DayOfWeek'val(fdm)-, 
put (Day Of Week' image (hf dm))-, put-line (""); 
end if; 

This code is used in section 83. 



86 . 

(Variables local to print-holidays 84) += 
hfdm : Day Of Week ; 
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87. 

( Print out holidays, as necessarily 87 ) = 
if status > 0 then 
if ~^nps then 

if (<h'(2) > 0) then 

hfdm *— DayOfWeek'val{di{ 2) + 3); put {Day Of Week' image{hfdm))] put{ii,3 ); 
put ( " u " ); put-line ( "Of f day" ); 
end if; 
end if; 

if status < 3 then 

hfdm <— DayOfWeek' val{di{0))] put {Day Of Week' image {hfdm))] put{ii,3)] 
put {" u "); put {S {holidays (<h'(l)))); 
if status 2 then 

put-line {"")] 

else 

put-line (" u ( Observed) " ); 
end if; 
end if; 
end if; 

This code is used in section 83. 



88 . 

( Procedures and Tasks in calyr 39 ) += 

procedure cal date {Julian : Long-integer] Month : out Month- Number] Day : out 
Day-Number] Year : out Integer) is 
{ Variables local to caldat 90 ) 
begin 

if {julian > IGREG) then 

( Correct for to Gregorian Calendar 89 ) 
else 

ja < — julian ; 

end if; 

( Now finish computation 91 ) 
end caldate ; 

89. 

( Correct for to Gregorian Calendar 89 ) = 
jalpha <— long.integer {{{float {julian — 1867216) — 0.25)/36524. 25) — 0.5); 
ja <— julian -f 1 + jalpha — long-integer (0.25 * float {jalpha) — 0.5); 

This code is used in section 88. 
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90. 

{ Variables local to caldat 90 ) = 

IGREG : constant long.integer <— (15 + 31 * (10 + 12 * 1582)); 
ja,jalpha : long.integer ; 

See also section 92. 

This code is used in section 88. 



91 . 

( Now finish computation 91 ) = 
jb *— ja + 1524; 

jc <- long.integer ((6680.0 + ( float(jb - 2439870) - 122.1)/365.25) - 0.5); 
jd <r— (365 * jc) + long.integer (0.25 * float (jc) — 0.5); 
je <— long.integer (float (jb — jd)/ 30.6001 — 0.5); 

Day *— Integer(jb — jd — long.integer (30.6001 * float (je) — 0.5)); 

TMonth +— Integer (je — 1 ); 
if (TMonth > 12) then 
Month *— Tmonth — 12; 
else 

Month <— Tmonth ; 

end if; 

Year +— integer (jc —4715); 
if (Month > 2) then 
Year +— Year — 1 ; 

end if; 

if Year < 0 then 
Year <— Year — 1 ; 

end if; 

This code is used in section 88. 

92 . 

(Variables local to caldat 90 ) += 
jb,jc,jd,je : long.integer ; 

Tmonth : integer ; 
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93. 

(Procedures and Tasks in calyr 39) += 

function julian- day (Month : Month-Number-, Day : Day-Number-, Year : Integer )return 
long-integer is 

( Variables local to Julian-Day 94 ) 
begin 

( Check for bad year 95 ) 

( Twiddle some variables before computing 96 ) 

( Compute julian number 98 ) 

( Test whether to change to Gregorian Calendar 99 ) 

return juT, 
end julian-day, 



94. 

( Variables local to Julian-Day 94 ) = 
jul : long-integer-, 

See also sections 97 and 100. 

This code is used in section 93. 

95. There is no year zero! 

( Check for bad year 95 ) = 
if ( Year = 0) then 
raise BadYear ; 
end if; 

This code is used in section 93. 

96. I translated this from C. I don’t pretend to understand it. 

( Twiddle some variables before computing 96 ) = 
if Year < 0 then 
TYear *— Year + 1; 
else 

TYear <— Year-, 

end if; 

if Month > 2 then 

jy *— TYear-, jm <— Month + 1; 
else 

jy <— TYear — 1; jm <— Month + 13; 

end if; 

This code is used in section 93. 
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97 . 

( Variables local to Julian-Day 94 ) += 

TYear,jy,jm : integer ; 

98 . Probably taken from the book Astronomical Formulae for Calculators. 

{ Compute julian number 98 ) = 

jul <— long-integer (365.25 * float [jy) — 0.5) + long-integer (30.6001 * float [jm) — 0.5) + 
long-integer [Day + 1720995); 

This code is used in section 93. 

99 . Gregorian Calendar was adopted on October 15, 1582. 

{ Test whether to change to Gregorian Calendar 99 ) = 

if long-integer [integer [Day) + 31 * [integer [Month) + 12 * Year)) > IGREG then 
ja <— integer (0.01 * float [jy) — 0.5); 

jul *— jul + long-integer[ 2 — ja + integer[ 0.25 * float [j a) — 0.5)); 
end if; 

This code is used in section 93. 

100 . 

(Variables local to Julian-Day 94) += 

IGREG : constant long-integer <— (15 + 31 * (10 + 12 * 1582)); 
ja : integer ; 



144 



CALYR BODY 



§101 APPENDIX E 

101 . 

{ Procedures and Tasks in calyr 39 ) += 

function IsWorkDay(YrDate : Time; NRaD : boolean <— false] 
debugit : boolean *— false) return boolean is 
{ Variables local to IsWorKDay 103 ) 
begin 

status <— 1; workday «— false] hoLdy (Current-Time , di , status)] 
if debugit then 

(Display hoLdy output 102) 
end if; 

dow <— GetDayOfWeek(YrDate)] 
if status = 0 then 

( Make sure not a Saturday or Sunday 106 ) 
elsif nrad then 

( Look if NraD off-Friday (or off-Thursday if Friday a holiday) 107 ) 
else 

( See if federal holiday 108 ) 
end if; 

if debugit then 

( Print if workday 104 ) 
end if; 

return workday] 
end Is WorkDay ; 

102 . 

(Display hoLdy output 102) = 

Split (Yrdate , Year , Month, Day , Seconds)] put("Status u = u "); put (status ,1)] 
put ("uudiu=u{" )i 
for i G 0 . . 2 loop 
put(di(i),i)] 

if i < 2 then 
put(",")] 
end if; 
end loop; 
putJine("y u "); 

This code is used in section 101. 
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103. 

(Variables local to IsWorKDay 103) = 

Year : Year-Number ; 

Month : Month-Number; 

Day : Day-Number ; 

Seconds : Day-Duration-, 
dow : DayOfWeek ; 

See also section 105. 

This code is used in section 101. 

104. 

( Print if workday 104 ) = 
print-date ( Yrdate ); 
if workday then 

put-line(" u is u a u workday . "); 
else 

put-line (" u is u N0T u a u workday . " ); 
end if; 

This code is used in section 101. 

105. 

( Variables local to Is WorKDay 103 ) += 
status : integer ; 
workday : boolean-, 
di : threearray ; 

Current-Time : Time <— YrDate-, 

106. 

( Make sure not a Saturday or Sunday 106 ) = 
if (dow Sun ) A ( dow Sat) then 
workday <— true; 

end if; 

This code is used in sections 101, 107, and 108(2). 

107. Make allowances for people (NRaD) working 5/4 weekly schedule. 

( Look if NraD off-Friday (or off-Thursday if Friday a holiday) 107 ) = 
if status = 3 then 

( Make sure not a Saturday or Sunday 106 ) 
end if; 

This code is used in section 101. 
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108 . If status > 2 could be Arbor Day, or other work holiday. 

{ See if federal holiday 108 ) = 
if status = 3 then 

{ Make sure not a Saturday or Sunday 106 ) 

end if; 

if status = 4 then 

( Make sure not a Saturday or Sunday 106 ) 

end if; 

This code is used in section 101. 

109 . 

{ Procedures and Tasks in calyr 39 ) += 

function DurationToCalendarTime(StartDate : Time, dailyhours : WorkHours ; 
hrs : Duration-, NRaD : boolean) return Time is 
(Variables local to DurationToCalendarTime 111) 
begin 

(Find next work-day 110 ) 

( Remove slop 112 ) 

( Find next work-day 110 ) 

( If partial day, account for it 114 ) ( Find next work-day 110 ) 

(Find last work-day 116) 

( Figure out partial day 117 ) 
return Current-Time] 
end DurationToCalendarTime ; 

110 . 

( Find next work-day 110 ) = 

while (~*IsWorkD ay (Current-Time, NRaD)) loop 
Current-Time * — IncrementDay (Current-Time)-, 

end loop; 

This code is used in sections 109(3) and 116. 

111 . 

(Variables local to DurationToCalendarTime 111) = 

Current-Time : Time < — StartDate-, 

See also sections 113 and 115. 

This code is used in section 109. 
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112. If the start date was not a work day, and the the number of hours in Start Date is 
greater then zero, remove it. (Maybe this should be an error.) 

( Remove slop 112 ) = 

Split ( Current _ Time , Year , Month , Day , Seconds ); 
if Current-Time ^ StartDate then 

Seconds <—0.0; Current-Time <— Time-of (Year , Month, Day , Seconds); 

end if; 

This code is used in section 109. 

113. 

(Variables local to DurationToCalendarTime 111) += 

Year : Year-Number; 

Month : Month-Number; 

Day : Day-Number; 

Seconds : Day-Duration; 

114. If the StartDate has seconds l zero then this means we are starting a new task in 
the middle of the day. 

( If partial day, account for it 114 ) = 

.yhrs <— hrs; yrday «— GetDayOfWeek(Current-Time); 
if (dailyhours (yrday) — seconds) > yhrs then 

Current-Time *— Current-Time + yhrs ; yhrs «— 0.0; 
else 

Current-Time <— Current-Time — Seconds; 

Current-Time <— IncrementDay (Current-Time); 
yhrs «— yhrs — (dailyhours (yrday) — seconds); 
end if; 

This code is used in section 109. 

115. 

(Variables local to DurationToCalendarTime 111) += 
yhrs : Duration; 
yrday : DayOfWeek; 
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116 . 

(Find last work-day 116) = 

yrday <— GetDay Of Week (Current-Time)', 
while yhrs > dailyhours (yrday) loop 

yhrs <— yhrs — dailyhours (yrday)] Current-Time <— IncrementDay (Current-Time)] 
{Find next work-day 110 ) 
yrday < — GetD ay Of Week (Current-Time)] 
if (yrday = Sat) V (yrday — Sun) then 
put ( "ERROR ! u ERR0R ! u ERR0R ! " ); newJine ; 

pu^'ToruSomeureasonufailedutOuf indunextuwork-dayuforudate^u" ); 

print-date ( Current-Time)] 

if (-iIsWorkDay (Current-Time , NRaD , True)) then 
p«t(" u (NOT u a u work-day. ) "); 
else 

pu<(" u (IS uu a u work-day. ) "); 

end if; 

new-line] raise BadDay] 
end if; 
end loop; 

This code is used in section 109. 

117 . 

( Figure out partial day 117 ) = 
if yhrs > 0.0 then 

Current-Time <— Current-Time + yhrs ; yhrs -<—0.0; 

end if; 

This code is used in section 109. 

118 . 

( Procedures and Tasks in calyr 39 ) += 

function CalendarTimeToDuration(StartDate : Time; dailyhours : WorkHours ; 
EndDate : Time; NRaD : boolean) return Duration is 
(Variables local to CalendarTimeToDuration 121 ) 
begin 

( Assert that input dates are correct 119 ) 

( Count work hours over total span of days 122 ) 
end CalendarTimeToDuration ; 
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119. The StartDate and EndDate must be valid work days and must have hours less 

then or equal to the total number of hours worked in a day. If this is not true, raise the 

BadDay exception. 

( Assert that input dates are correct 119 ) = 

if ->IsWorkDay (StartDate, NRaD) V ~<IsWorkDay (EndDate , NRaD) then 
raise BadDay ; 
end if; 

Split (StartD ate , StartYear , StartMonth, StartDay , StartS econds)] 
dow «— GetD ay OfWeek (StartD ate)] 
if StartSeconds > dailyhours (dow) then 
raise BadDay ; 
end if ; 

Split(EndDate , EndYear , EndMonth, EndDay , EndSeconds ); 
dow <— GetD ay OfWeek (EndDate)] 
if EndSeconds > dailyhours (dow) then 
raise BadDay ; 
end if; 

See also section 120. 

This code is used in section 118. 

120. Also check that EndDate l StartDate. 

{ Assert that input dates are correct 119 ) += 
if StartDate > EndDate then 
raise BadDay, 
end if; 

121. 

(Variables local to CalendarTimeToDuration 121 } = 

StartYear , EndYear : Year-Number] 

StartMonth , EndMonth : Month-Number] 

StartDay , EndDay : Day-Number] 

StartSeconds , EndSeconds : Day-Duration] 
dow : DayOfWeek] 

See also sections 124 and 127. 

This code is used in section 118. 
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122 . 

( Count work hours over total span of days 122 } = 
if SameDay (StartDate , EndDate) then 
{ Figure out duration for same day 123 ) 
else 

{ Count work hours for first day 125 ) 

{ Count work hours for intermediate days 126 ) 

{ Count work hours for last day 128 ) 
end if; 
return hrs ; 

This code is used in section 118. 

123. Easy. Just Subtract. 

( Figure out duration for same day 123 ) = 
hrs <— EndDate — StartDate ; 

This code is used in section 122. 

124. 

(Variables local to CalendarTimeToDuration 121 ) += 
hrs : duration ; 

125. 

( Count work hours for first day 125 ) = 

dow GetD ay OfWeek (StartDate)] hrs <— dailyhours (dow ) — StartSeconds; 

This code is used in section 122. 

126. 

( Count work hours for intermediate days 126 ) = 

Current-Time <— Time- Of (Start Year , StartMonth, StartDay, 0.0); 
Current-Time IncrementDay (Current-Time)] 
while -^SameDay ( Current- Time , EndDate ) loop 
if IsWorkD ay (Current-Time ,NraD) then 

dow <— GetD ay Of Week (Current-Time)] hrs *— hrs + dailyhours (dow ); 
end if; 

Current-Time <— IncrementDay (Current-Time)] 

end loop; 

This code is used in section 122. 

127. 

(Variables local to CalendarTimeToDuration 121 ) += 

Current-Time : Time] 
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128 . 

( Count work hours for last day 128 ) = 
hrs <— hrs + EndSeconds ; 

This code is used in section 122. 

129 . 

(Procedures and Tasks in calyr 39) += 

function SameDay(Timel , Time2 : Time)return boolean is 
(Variables local to SameDay 130 ) 
begin 

Split(Timel , Yearl , Monthl , Dayl , Seconds ); 

Split(Time2 , Year2 , M0nth2 , Day2 , Seconds ); 
if ( Yearl — Year2 ) A ( Monthl = Month2 ) A ( Dayl = Day2 ) then 
return true ; 
else 

return false ; 
end if; 

end SameDay ; 

130 . 

( Variables local to SameDay 130 ) = 

Yearl , Year2 : Year-Number ; 

Monthl , Month2 : Month-Number ; 

Dayl ,Day2 : Day-Number] 

Seconds : Day-Duration] 

This code is used in section 129. 

131 . 

( Procedures and Tasks in calyr 39 ) += 

function GetDayOfWeek(Today : Time )return DayOfWeek is 
jul : long-integer] 

Month : Month-Number ; 

Day : Day-Number ; 

Year : Year-Number] 

Seconds : Day-Duration] 
fdy : DayOfWeek] 
begin 

Split(Today , Year , Month , Day , Seconds)] jul := julian-day (Month , Day , Year)] 
fdy <— DayOfWeek' val(( jul + 1) mod 7); return fdy] 
end GetDayOfWeek] 
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132. Essentially converts hours to seconds. 

{ Procedures and Tasks in calyr 39 ) += 

function ConvertHoursToDuration(hrs : natural) return Duration is 
dur : duration ; 
begin 

dur <— duration(hrs) * 3600.0; return dur] 
end ConvertHours ToDuration ; 

133. Essentially converts seconds to hours. 

{ Procedures and Tasks in calyr 39 ) += 

function ConvertDurationToHours(dur -.Duration) return natural is 
hrs : natural ; 
begin 

hrs *— natural (float [dur)/ 3600.0); return hrs ; 
end ConvertDurationToHours ; 



{ Procedures and Tasks in calyr 39 ) += 

Procedure Split(Seconds : Day-Duration] Hour : out Hour-Number] Minute : out 
Minute-Number ; 

Second : out Second-Number) is yrsecs : Day-Duration <— Seconds ; 

begin 

Hour <— integer (yrsecs) / 3600; yrsecs <— yrsecs — Duration(Hour * 3600); 

Minute *— integer(yrsecs)/60 ; yrsecs *— yrsecs — Duration (Minute * 60); 

Second *— integer (yrsecs)] 
end Split] 

135. Prints out the date. 



134. 



mm 



dd 

HH 

MM 

SS 



yy 



cc 



Month number 

Day number in the month 

Hour number (24 hour system) 

Minute number 

Second number 

Century minus one 

Last 2 digits of the year number 



The month, day, year, and century may be omitted; the current values are applied as 
defaults. For example: 



date 10080045 



sets the date to Oct 8, 12:45 a.m. The current year is the default because no year is 
supplied. 
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136 . This was written because there seemed to be an error in adding 86, 400.0 seconds 
to a day and then expecting the answer to come out right. Errors occured around April 
7, 1997 and October 26, 1997. I believe it is a GNAT bug for version 3.09. 

( Procedures and Tasks in calyr 39 ) += 

function IncrementDay (YrD ate : Time )return Time is 
jul : longAnteger ; 

Year : Year-Number] 

Day : Day-Number] 

Month : Month-Number] 

Seconds : Day-Duration] 
begin 

Split(Yrdate , Year , Month, Day , Seconds)] jul *— julian-day (Month, Day , Year)] 
jul * — jul + 1; caldate (jul, Month, Day , Year)] 
return Time-Of ( Year , Month, Day, Seconds ); 
end IncrementDay ; 
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137 . 

( Procedures and Tasks in calyr 39 ) += 
procedure print-date (date : time) is 
{ Variables local to print-date 138 ) 
do-alternate : boolean *— true ; 
begin 

Split (date , Year, Month , Day , Seconds ); 
if Month < 10 then 
put(" 0"); 
end if; 

put (natural (Month), 1); put ("/"); 
if day < 10 then 

put{" o"); 

end if; 

put (natural (Day), 1); put("/")\ put (natural (Year), 4); 
Split(Seconds , Hour , Minute , Second ); 
if do. alternate then 

if Hour < 10 then 
put(" 0"); 
end if; 

put (natural (Hour), 1); 
else 

put( n □”); 

if Hour < 10 then 
put(" 0"); 
end if; 

put (natural (Hour), 1); put (" : "); 
if Minute < 10 then 
put(" 0"); 
end if; 

put (natural (Minute), 1); put(" : "); 
if Second < 10 then 
put(" 0"); 
end if; 

put (natural (Second ), 1); 
end if; 

end print. date; 
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138 , 

(Variables local to print-date 138) = 
Year : Year-Number ; 

Month : Month-Number ; 

Day : Day-Number ; 

Seconds : Day_Duration\ 

Hour : Hour-Number ; 

Minute : Minute-Number ; 

Second : Second-Number ; 

This code is used in section 137. 
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139. 

{ Procedures and Tasks in calyr 39 ) += 

procedure print-date (outfile : file-type ; date : time ) is 
( Variables local to fprint-date 140 ) 
do- alternate : boolean <— true ; 
begin 

Split ( date , Year , Month , Day , Seconds ); 
if Month < 10 then 
put(outfile , "0"); 
end if; 

put(outfile , natural(Month), 1); put(outfile , 
if day < 10 then 
put(outfile , "0"); 

end if; 

put(outfile, natural (D ay ),1)] put(outfile , "/"); put(outfile , natural( Fear), 4); 
Split(Seconds , Hour , Minute , Second ); 
if do-alternate then 
put(outfile , 
if Hour < 10 then 
put(outfile, "0"); 
end if; 

put(outfile , natural (Hour), 1); 
else 

put(outfile , " u "); 
if Hour < 10 then 
put(outfile , "0"); 
end if; 

put(outfile , natural (Hour), 1); put(outfile ," : "); 
if Minute < 10 then 
put(outfile , "0"); 

end if; 

put(outfile , natural (Minute), 1); put(outfile , 
if Second < 10 then 
put(outfile , "0"); 

end if; 

put(outfile , natural(Second), 1); 
end if; 

end print-date ; 
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140, 

(Variables local to fprint-date 140 ) = 

Year : Year. Number] 

Month : Month-Number ; 

Day : Day-Number ; 

Seconds : Day-Duration ; 

Hour : Hour-Number ; 

Minute : Minute-Number ; 

Second : Second-Number ; 

This code is used in section 139. 

141. 

( Procedures and Tasks in cafyr 39 ) += 

function get-date (infile : file-type) return Time is 
( Variables local to f get-date 142 ) 
begin 

get(infile , ndum)] Month <— ndum] 
if debug2 then 

put ("Moiith u = u n ); put(Month ,1); put-line(" 
end if; 

get-immediate (infile , chr)] get (in file, ndum)] Day *— ndum; 
if debugZ then 

pu<("Day u = u M ); put(Day , 1); put-line (" . 
end if; 

get-immediate (infile , cAr); get(infile , ndum)] 
if ndum < 100 then 
if ndum < 50 then 
Fear* <— ndum + 2000; 
else 

Year «— ndum + 1900; 
end if; 
else 

Year < — ndum ; 

end if; 

if debugS then 

put("Year u = u M ); put ( Fear , 1); put-line (" 
end if; 

get-immediate (infile , chr ); get (infile , ndum)] Hour *— ndum; 
return Time-0 f (Year , Month , Day , ConvertHours To Duration ( Hour))] 
end get-date ; 
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142 . 

( Variables local to fget-date 142 ) = 
ndum : natural ; 
chr : character ; 

Year : Year-Number ; 

Month : Month-Number ; 

Day : Day-Number ; 

Hour : natural ; 

This code is used in section 141. 
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143. 

( Procedures and Tasks in calyr 39 ) += 

function get-date (str : in Ustring)return Time is (Variables local to get-date 144) 
begin 

if debug2 then 

puf ("Parsing u string|j'"); put(S(str )); put-line("' 
end if; 

tstr <— str] get(S (tstr), ndum, Last)] Month <— ndum] 
if debugZ then 

pu<("Month u =u"); put(Month, 1); put-line (" 
end if; 

ind <— index(tstr , "/"); tstr <— tail (tstr , length (tstr) — ind)] 
get(S (tstr), ndum, Last)] Day <— ndum] 
if debug2 then 

put( ,, Day u = u "); put(Day, 1); putJine{" .")] 
end if; 

ind *— index (tstr ," /"); tstr <— tail (tstr , length (tstr) — ind)] 
get(S(tstr), ndum, Last ); 
if debug2 then 

pid("Parsing u string u '"); put(S(tstr))] put-line ("' ."); put ("ndum u = u "); 
put(ndum, 1); put-line (" ."); 
end if; 

if ndum < 100 then 
if ndum < 50 then 
Year *— ndum + 2000; 
else 

Year <— ndum + 1900; 
end if; 
else 

Year *— ndum] 

end if; 

if debug2 then 

put("Year u = u "); put {Year , 1); put-line (" ."); 
end if; 

ind <— index (tstr ,"+")] tstr *— tail (tstr , length (tstr) — ind)] 
get(S(tstr), ndum, Last)] Hour <— ndum] 

return Time-Of (Year , Month, Day , ConvertHoursToDuration(Hour))] 
end get-date] 
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144 . 

(Variables local to get-date 144} = 
ndum : natural ; 

Year : Year-Number ; 

Month : Month-Number ; 

Day : Day-Number ; 

Hour : natural ; 

: positive ; 
foir : ustring ; 
zW : natural ; 

This code is used in section 143. 
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145. Test Driver. This is the main routine that starts everything. 

146. 

output to file main.adb 

with Text-10 ; 
use Text-10 ; 
with Ada. Calendar] 
use Ada. Calendar] 
with calyr] 
use calyr] 
with ustrings] 
use ustrings] 
with getopt] 
use getopt] 
procedure main is 

{ Variables local to main 150 ) 

package yrAo is new integer Ao (Year-Number)] 

use yrAo] 

package booLio is new enumerationAo (boolean)] 
use booLio] 
begin 

{ Get options 147 ) 
print-holidays ( yr , nps ); 
end main] 

147. 

( Get options 147 ) = 

( Get year 148 ) 

{ Get nps 149 ) 

This code is used in section 146. 

148. 

( Get year 148 ) = 

if option-present ({/("-year")) then 

get-option(U("-year“),param ); get(S(param), yr , Last)] 
else 

yr «— 1997', 
end if; 

This code is used in section 147. 
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149 . 

{ Get nps 149 ) = 

if option.present(U("-nps")) then 

get-option{U("—a.ps"),param ); get(S(param ), nps , Last)-, 
else 

nps <— false ; 

end if; 

This code is used in section 147. 

150 . 

(Variables local to main 150 ) = 
yr : Year.number ; 
param : JJstring ; 

Last : positive ; 
nps : boolean ; 

This code is used in section 146. 
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151. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

152. RCS Keywords. 

$RCSfile: calyr.aweb,v 
$Revision: 1.1 
$Date: 1997/08/18 22:43:35 
$ Author: evansjr 

$Id: calyr.aweb,v 1.1 1997/08/18 22:43:35 evansjr Exp evansjr 

$Locker: evansjr 
$ State: Exp 
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153. Index. Here is a cross-reference table for the MAIN program. All modules in which 
an identifier is used are listed with that identifier, except that reserved words are indexed 
only when they appear in format definitions, and the appearances of identifiers in module 
names are not indexed. Underlined entries of subprograms and packages correspond to 
sections where this entity is specified, whereas entries in italic type correspond to the 
section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



Ada : 9, 32, 146. 

already-leaped : 38, 42. 

Apr: 13, 59. 

Aug: 13. 

BadDay: 12, 116, 119-120. 

BadYear: 12, 95. 

booLio: 146 . 

boolean : 16, 20-23, 38, 81, 101, 105, 109, 

118, 129, 137, 139, 146, 150. 
bpp : 47-48, 63. 

caldat: 57, 58-59, 61. 

caldate: 19, 88, 136. 

Calendar: 9, 146. 

CalendarTimeToDuration : 22, 118 . 

Calyr: 40-41. 

calyr: 9 , 42, 146. 

calyr . adb : 9. 

calyr. ads : 9. 

character: 142. 

chr: 141-142. 

Command-Line: 9. 

ConvertDurationToHours: 26. 133 . 

ConvertHoursToDuration: 25, 132, 

141, 143. 

Current-Time: 101, 105, 109-112, 114, 

116-117, 126-127. 

dailyhours: 21-22, 109, 114, 116, 118- 

119, 125-126. 

date: 28, 70-76, 137, 139. 
day: 137, 139. 

Day: 18-19, 40-41, 44, 69, 72-76, 78, 80, 

88, 91, 93, 98-99, 102-103, 112-113, 
131, 136-144. 

Day-Duration : 27, 41, 103, 113, 121, 

130-131, 134, 136, 138, 140. 



Day-Number: 18-19, 41, 88, 93, 103, 113, 

121, 130-131, 136, 138, 140, 142, 144. 
DayofWeek: 14, 80. 

Day Of Week: 13, 24, 44, 46, 50, 52- 

53, 62-63, 70, 80, 85-87, 103, 115, 
121, 131. 

Dayl : 129-130. 

Day2: 129-130. 

debug: 38. 

debugit: 20, 101. 

debug2: 38, 141, 143. 

Dec: 13, 77, 82. 

di: 17, 39-40, 44, 69, 72-76, 78, 80, 

83-84, 87, 101-102, 105. 
do-altemate: 137, 139. 

do-nps: 16, 81. 

dow: 101, 103, 106, 119, 121, 125-126. 

dt: 56-57, 59, 61-62. 

dur: 26, 132-133. 

duration: 124, 132. 

Duration: 15, 21-22, 25-26, 109, 115, 

118, 132-134. 

DurationToCalendarTime: 21., 109 . 

dw: 70-71, 74-76, 79-80. 

dy: 49, 52-53, 56, 66-67, 69-70. 
easter: 56, 59. 

edt: 56, 58. 

EndDate: 22,118-120,122-123,126. 

EndDay: 119, 121. 

EndMonth: 119, 121. 

EndSeconds : 119, 121, 128. 

EndYear: 119, 121. 

enumerationAo : 146. 

Exception: 12. 

false : 20, 38, 101, 129, 149. 
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fde: 59, 61-62. 

fdm : 63, 65-66, 70, 79, 85. 

fdy. 44, 46, 62-63, 131. 

Feb: 13, 42, 52. 

file-type: 28-29, 139, 141. 

fl: 49, 70, 72-73. 

float: 89, 91, 98-99, 133. 

fourarray: ^2, 49, 64. 

Fri: 13-14, 80. 

get: 141, 143, 148-149. 

get-date: 29, 141 , 143. 

get-immediate: 141. 

get-option: 148-149. 

GetDayOfWeek : 24, 101, 114, 116, 119, 

125-126, 131 . 
getopt: 146. 

hfdm: 85-87. 

hmn: 40-41, 66-67, 69-70, 72-77. 

ho: 67-68, 70, 72-76. 

hoi: 43, 50-56, 66-67, 69-70, 72-76, 80. 

hoLdy: 17, 39, 67, 83, 101. 

hoLtype: 49, 50. 

holidays : 35, 87. 

Hour: 27, 134, 137-144. 

Hour-Number: H, 27, 134, 138, 140. 

hrs: 21, 25, 109, 114, 122-126, 128, 

132-133. 
i: M, 102- 
ICOL: 37, 54. 

IELC: 37, 66. 

IEST: 37, 56. 

IGFR: 37, 56. 

I GREG: 88, 90, 99-100. 

IHAL: 37. 

ii: 63, 66-70, 72-76, 83, 85, 87. 
image: 82, 85, 87. 

IMEM: 37, 53. 

IMLK: 37, 51. 

IncrementDay: 30, 110, 114, 116, 126, 

136 . 

ind: 143-144. 

index : 143. 

infile: 29, 141. 



int-io : 38. 

integer: 11-12, 17, 36-39, 44, 48, 57, 
60-61, 63-65, 68-69, 71, 84, 91-92, 
97, 99-100, 105, 134. 

Integer: 18-19, 88, 91, 93. 

integer-io: 38, 146. 

IN YD: 37, 80. 

IPRS: 37, 52. 

IsWorkDay: 20, 101, HO, 116, 119, 126. 
IVET: 37, 55. 
ix: 49, 74-76, 80. 
j: 42. 

ja: 88-91, 99-100. 

JAFD: 36, 50. 
jalpha: 89-90. 

JAN: 51. 

Jan: 13, 80, 82. 

jb : 91-92. 
jc: 91-92. 

JCHR: 36, 50. 

JCOL: 36, 50. 
jd: 91-92. 
je: 91-92. 

JELC: 36, 50. 

JEST: 36, 50. 

JFAT: 36, 50. 

JFLG: 36, 50. 

JGFR: 36, 50. 

JHAL: 36, 50. 

JIND: 36, 50. 

jj: 63-64, 67, 69, 72-73, 78. 

JLAB: 36, 50. 
jm: 96-98. 

JMEM: 36, 50. 

JMLK: 36, 50. 

JMOT: 36, 50. 

JNYD: 36, 50. 

JPRS: 36, 50. 

JSPT: 36, 50. 

JTHX: 36, 50. 

jul: 44-45, 93-94, 98-99, 131, 136. 

Jul: 13. 

Julian: 19, 88. 
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julian : 88—89. 

julian-day: 18, 44, 93, 131, 136. 

Julian-day: 19. 

Jun: 13. 

JVAL: 36, 50, 74. 

JVET: 36, 50. 
jy : 96-99. 

Last: 143-144, 148-150. 

Idm: 63. 

Idpm: 34, 42, 63. 

length: 143. 

long-integer: 18, 45, 89-94, 98-100, 

131, 136. 

Long-integer: 19, 88. 

main : 146 . 

main.adb: 146. 

Mar: 13, 56, 59. 

May: 13, 53. 

Minute: 27, 134, 137—140. 

Minute-Number: 11, 27, 134, 138, 140. 

mn: 56-57, 59, 62. 

mon: 82, 83, 85. 

MON: 50. 

Mon: 13-14, 52-53. 

Month: 18-19, 40-41, 44, 50, 57, 63, 

69-70, 88, 91, 93, 96, 99, 102-103, 
112-113, 131, 136-144. 
month: 13, 40, 42, 62, 82-83, 85. 

Month-Number: 18-19, 33-34, 41, 88, 

93, 103, 113, 121, 130-131, 136, 138, 
140, 142, 144. 

Monthl : 129-130. 

Month2: 129-130. 

MOnth2: 129. 

natural: 25—26, 33—35, 132—133, 137, 

139, 142, 144. 

ndm: 33, 42, 56, 59, 62-63, 69-70, 
78-80, 83. 
ndum: 141-144. 

new-line: 116. 

Nov: 13, 55, 66. 

nps: 38, 81, 87, 146, 149-150. 

NraD: 126. 



nrad: 101. 

NRaD: 20-22, 101, 109-110, 116, 

118-119. 

NumHolidays : 35. 

Oct: 13, 54-55. 
ofr: 63. 

ofrdy : 63-64, 67, 69, 72-73, 78. 
option-present: 148—149. 

outfile: 28, 139. 

param: 148-150. 

pfm : 59-60. 

pos : 42, 50, 52-53, 62-63, 70, 80, 83. 

positive: 144, 150. 

print-date: 28, 104, 116, 137, 139 . 

print-holidays : 16, 81, 146. 

private: 6. 

Procedure : 27, 134. 

procedure: 6. 

protected: 6. 

put: 82-83, 85, 87, 102, 116, 137, 139, 
141, 143. 

put-line: 82-83, 85, 87, 102, 104, 141, 

143. 

SameDay: 23, 122, 126, 129. 

SAT: 50. 

Sat: 13, 70, 106, 116. 

Second: 27, 134, 137-140. 

Second-Number: H, 27, 134, 138, 140. 
seconds : 114. 

Seconds: 27, 40-41, 102-103, 112-114, 

129-131, 134, 136-140. 

Sep: 13. 

Split: 27, 40, 102, 112, 119, 129, 131, 
134, 136-137, 139. 

StartDate: 21-22, 109, 111-112, 118- 

120, 122-123, 125. 

StartDay: 119, 121, 126. 

StartMonth: 119, 121, 126. 

StartSeconds: 119, 121, 125. 

StartYear: 119, 121, 126. 

status: 17, 39-40, 69, 72-76, 78, 80, 

83-84, 87, 101-102, 105, 107-108. 
str: 29, 143. 
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Strings: 32. 

succ: 62. 

SUN : 50. 

Sun : 13, 70, 106, 116. 

system dependencies: 151. 

tail: 143. 

TEXTJO: 9. 

TexLlO : 146. 

text Jo: 10. 

threearray: 12, 17, 39, 84, 105. 

THU: 50. 

Thu: 13. 

Time: 20-24, 29-30, 101, 105, 109, 111, 

118, 127, 129, 131, 136, 141, 143. 
time: 17, 28, 39, 137, 139. 

Time-Of: 126, 136, 141, 143. 

Time-of: 83, 112. 

Timel : 23, 129. 

Time2: 23, 129. 

TMonth: 91. 

Tmonth: 91-92. 

tmp: 47-48, 78. 

Today: 24, 131. 

true: 38, 42, 106, 129, 137, 139. 

True: 116. 

tstr: 143-144. 

TUE: 50. 

Tue: 13. 

tYear: 47-48. 

TYear: 96-97. 

Type: 15. 

ugly: 67, 69. 

Unbounded : 32. 

UNST: 63-64, 67. 

Use: 32. 

ustring: 144. 

Ustring: 29, 35, 143, 150. 

U strings: 9, 32. 

ustrings : 146. 

val: 40, 44, 85, 87, 131. 
verbose: 38, 82-83. 

Wed: 13. 

WeekDay: 14, 15. 



wn: 49, 51-56, 66-67, 70. 

workday: 101, 104-106. 

WorkHours: 15, 21-22, 109, 118. 

Year : 18-19, 40-42, 44, 47, 51-52, 54-56, 

59, 63, 66, 88, 91, 93, 95-96, 99, 
102-103, 112-113, 131, 136-144. 
Year-number: 150. 

Year-Number: 16, 18, 41, 59, 81, 103, 

113, 121, 130-131, 136, 138, 140, 
142, 144, 146. 

Yearl : 129-130. 

Year2 : 129-130. 

yhrs: 114-117. 

yr: 16, 81, 83, 146, 148, 150. 

yrJo : 146 . 

YrDate: 20, 30, 101, 105, 136. 

Yrdate: 102, 104, 136. 

yrdate: 17, 39-40. 

yrday: 114-116. 

yrsecs: 134. 
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( Assert that input dates are correct 119, 120 ) Used in section 118. 

( Calculate beginning date of 1st pay period in year 47 ) Used in section 43. 

{ Calculate weekday of Jan 1. 44 ) Used in section 43. 

( Check for bad year 95 ) Used in section 93. 

( Check for no more holidays 69 ) Used in section 67. 

( Check if leap year 42 ) Used in section 39. 

( Check if off- Friday moved back to Thursday 73 ) Used in section 67. 

( Compute Easter 56 ) Used in section 43. 

{ Compute julian number 98 ) Used in section 93. 

( Compute weekday for Paschal Full Moon 62 ) Used in section 59. 

( Correct for to Gregorian Calendar 89 ) Used in section 88. 

( Count work hours for first day 125 ) Used in section 122. 

{ Count work hours for intermediate days 126 ) Used in section 122. 

( Count work hours for last day 128 ) Used in section 122. 

( Count work hours over total span of days 122 ) Used in section 118. 

( December 31 a Friday the observe Saturday, January 1st 80 ) Used in section 77. 

( December processing 77 ) Used in section 67. 

(Display hoLdy output 102) Used in section 101. 

( Exhaust any earlier off-Fridays 72 ) Used in section 67. 

( Figure out duration for same day 123 ) Used in section 122. 

( Figure out election day 66 ) Used in section 63. 

( Figure out partial day 117 ) Used in section 109. 

( Find last work-day 116 ) Used in section 109. 

( Find next work-day 110 ) Used in sections 109(3) and 116. 

( Get nps 149 ) Used in section 147. 

( Get options 147 ) Used in section 146. 

(Get year 148) Used in section 147. 

( Holiday with fixed week day or fixed date 70 ) Used in section 67. 

(If partial day, account for it 114 ) Used in section 109. 

( Is first of next year a Friday or Saturday and this is an off-Friday? 78 ) Used in section 77. 
( Local Procedures 59 ) Used in section 9. 

( Look if NraD off-Friday (or off-Thursday if Friday a holiday) 107 ) Used in section 101. 

( Loop over holidays and Off-Fridays 67 ) Used in section 39. 

( Loop through days of month 83 ) Used in section 82. 

( Loop through months 82 ) Used in section 81. 

(Make sure not a Saturday or Sunday 106 ) Used in sections 101, 107, and 108(2). 

( Monday/Friday extra day 75) Used in section 67. 

( Now finish computation 91 ) Used in section 88. 

( Package boiler-plate 9 ) Used in section 8. 

(Packages needed by calyr body 10, 32) Used in section 9. 

( Parse date 40 ) Used in section 39. 

(Print if Workday 104 ) Used in section 101. 

( Print out first day of month 85 ) Used in section 83. 
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( Print out holidays, as necessarily 87 ) Used in section 83. 

(Procedures and Tasks in calyr 39, 81, 88, 93, 101, 109, 118, 129, 131, 132, 133, 134, 136, 137, 139, 
141, 143 ) Used in section 9. 

( Remove slop 112 ) Used in section 109. 

( Saturday non- work holiday 76 ) Used in section 67. 

( See if federal holiday 108 ) Used in section 101. 

( Set month 63 ) Used in section 39. 

( Set year 43 ) Used in section 39. 

( Specification of procedures visible from calyr 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 
29, 30 ) Used in section 9. 

( Specification of types and variables visible from calyr 11, 12, 13, 14, 15 ) Used in section 9. 
( Test whether to change to Gregorian Calendar 99 ) Used in section 93. 

( Twiddle some variables before computing 96 ) Used in section 93. 

( Types and Variables local to hoLdy 41, 45, 64, 68, 71 ) Used in section 39. 

( Types and variables local to easter 60, 61 ) Used in section 59. 

( Types local to calyr 57 ) Used in section 9. 

( Update Columbus Day 54 ) Used in section 43. 

{ Update ML King Day 51 ) Used in section 43. 

( Update Memorial Day 53 ) Used in section 43. 

( Update President’s Day 52 ) Used in section 43. 

( Update Veteran’s Day 55 ) Used in section 43. 

( Variables local to main 150 ) Used in section 146. 

(Variables local to CalendarTimeToDuration 121, 124, 127) Used in section 118. 

(Variables local to DurationToCalendarTime ill, 113, 115) Used in section 109. 

(Variables local to IsWorKDay 103, 105) Used in section 101. 

(Variables local to Julian-Day 94, 97, 100 ) Used in section 93. 

(Variables local to SameDay 130 ) Used in section 129. 

( Variables local to caldat 90, 92 ) Used in section 88. 

( Variables local to calyr 33, 34, 35, 36, 37, 38, 46, 48, 49, 50, 58, 65 ) Used in section 9. 

( Variables local to fget-date 142 ) Used in section 141. 

(Variables local to fprint-date 140 ) Used in section 139. 

(Variables local to get-date 144) Used in section 143. 

(Variables local to print-date 138 ) Used in section 137. 

( Variables local to print-holidays 84, 86 ) Used in section 81. 

( Weekday of December 31 79 ) Used in section 77. 

( Work, and normal and Sunday non-work, holiday 74 ) Used in section 67. 
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System-dependent changes 15 178 
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1. Introduction. Here is the Ada code for routines used in calculating probaility 
distributions. This code uses Donald Knuth’s WEB format for literate programming. To 
compile and link the code in its present format you will need the Ada version of the WEB 
tool. 

It is available on-line via the world-wide-web at URL: 

http:/ /white.nosc.mil/~evansjr/literate/ 



2. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
see the paper Literate Programming , by Donald Knuth in The Computer Journal, Vol 27, 
No. 2, 1984; or the book Weaving a Program: Literate Programming in WEB by Wayne 
Sewell, Van Nostrand Reinhold, 1989. Another good source of information is the Usenet 
group comp. programming. literate. It has information on new tools and Frequently Asked 
Questions (FAQs). 

3. The program consists of several packages that are declared right now; each of these 
packages and either the specification and the body of the packages are sent to a separate 
file. The main program itself is declared later. (Since the original AWEB package was 
written for Ada ’83, it does not properly format new Ada ’95 keywords protected and 
private . We remedy using the web format commands below. 

format protected = procedure 
format private = procedure 

4. As a way of explanation, each “Module” withing angle brackets (< >) is expanded 

somewhere further down in the document. The trailing number you see within the brackets 
is where you can find this expansion. You can treat the modules names as a PDL (Program 
Descriptor Language), a highly recommened way of writing and documenting code. 

( Package boiler-plate 5 ) 
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5. Probability Primitives. 

( Package boiler-plate 5 ) = 

output to file probability .ads 

{ Needed packages 6 ) 
package probability is 

( Specification of types and variables visible from probability 7 ) 
( Specification of procedures visible from probability 8 ) 
end probability ; 

output to file probability . adb 

package body probability is 
( Variables local to probability 10 ) 

(Procedures and Tasks in probability 11 ) 
end probability ; 

This code is used in section 4. 

6. Here is the specification for generics. 

( Needed packages 6 ) = 

with Ada .Numerics .Float ^Random ; 

See also section 12. 

This code is used in section 5. 



7. 

( Specification of types and variables visible from probability 7 ) = 
type booLarray is array ( integer range <>) of boolean ; 

This code is used in section 5. 



8 . 

( Specification of procedures visible from probability 8 ) = 
function Uniform (Low , High : Float )return float; 
function Uniform(Low , High : Natural ) return Natural ; 
procedure sample (M , N tin natural \yr sample : out booLarray)-, 
This code is used in section 5. 
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PROBABILITY FUNCTIONS BODY 



10 . 

{ Variables local to probability 10 ) = 
debug : boolean <— false] 
FirstTime : boolean <— true ; 

This code is used in section 5. 



11 . 

(Procedures and Tasks in probability 11 ) = 

function U niform (Low , High : Float)return float is 
use Ada. Numerics. Float JR^andom] 

PI : Uniformly .Distributed] 

G : Generator] 
answer : float] 
tmp : float ; 
begin 

Reset(G)] PI *— Random(G)] tmp ( High — Low)] answer *— tmp * (PI ) + Low 

return answer] 
end Uniform] 

See also sections 13 and 14. 

This code is used in section 5. 



12 . 

( Needed packages 6 ) += 
with Text JO] 
use Text JO] 
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13. 

(Procedures and Tasks in probability 11 ) += 

function Uniform (Low , High : natural) return natural is 
use Ada. Numerics. Float-Random] 

PI : Uniformly-Distributed] 

G : Generator] 
tmp , tmp2 : float ; 
answer : natural] 

package flt-io is new float_io (float ); 
use flt-io ] 
begin 

if Low = High then 
answer <— Low] 
else 

if FirstTime then 

Reset (G, 68069); FirstTime <— false] 
else 

Reset (G); 
end if; 

PI <— Random(G)] tmp <— float(High — Low + 1); tmp2 <— ( tmp * Pi) — 0.5; 
if (debug) then 

^ut( M Rauidoin u generated u " ); put(Pl)] putJine(” . u ")] 
put(" (high-low+l) u tmp u = u "); put(tmp)] putJine(" . u ")', 
put("(tmp*pl) u tmp2 u = u "); put(tmp2)] putJine(" . u "); 
end if; 

answer <— natural (tmp 2 ) + Low] 
end if; 

return answer] 
end Uniform] 
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14. Based on a routine from the September, 1987 Communications of the ACM. 

(Procedures and Tasks in probability 11 } += 

procedure sample (M , N : in natural \yr sample : out booLarray) is 
t : natural ; 
k : natural ; 
begin 

for j € 1 . . N loop 
yrsample(j) *— false ; 
end loop; 

k <— N — M + 1] 
for j E k .. N loop 
t <— uniform{\,j)\ 
if yrsample{t) then 
yrsample(j) <— true ; 
else 

yrsample(t ) <— true ; 

end if; 
end loop; 
end sample ; 
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15. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

16. RCS Keywords. 

$RCSfile: probability.aweb,v 
$Revision: 1.1 
$Date: 1997/08/03 21:35:14 
$Author: evansjr 

$Id: probability.aweb,v 1.1 1997/08/03 21:35:14 evansjr Exp evansjr 

$Locker: evansjr 
$State: Exp 



178 



INDEX 



§17 APPENDIX F 

17. Index. Here is a cross-reference table for the MAIN program. All modules in which 
an identifier is used are fisted with that identifier, except that reserved words are indexed 
only when they appear in format definitions, and the appearances of identifiers in module 
names are not indexed. Underlined entries of subprograms and packages correspond to 
sections where this entity is specified, whereas entries in italic type correspond to the 
section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



Ada : 6, 11, 13. 

answer : 11, 13. 

booLarray : 7, 8, 14. 

boolean : 7, 10. 

debug : 10, 13. 

false : 10, 13-14. 

FirstTime : 10, 13. 

float: 8, 11, 13. 

Float : 8, 11. 

float Jo: 13. 

Float-Random: 6, 11, 13. 

fit Jo : 13 . 

Generator: 11, 13. 

High: 8, 11, 13. 

integer: 7. 

j: 14. 

Low: 8, 11, 13. 

natural: 8, 13-14. 

Natural: 8. 

Numerics: 6, 11, 13. 

private: 3. 

probability: 5. 

probability. adb : 5. 

probability. ads : 5. 

procedure: 3. 

protected: 3. 

put: 13. 

putJine: 13. 

PI: 11, 13. 

Random: 11, 13. 

Reset: 11, 13. 

sample : 8, 14. 

system dependencies: 15. 

Text JO: 12. 

imp: 11, 13. 



tmp2 : 13. 

true: 10, 14. 

uniform : 14. 

Uniform: 8, 1A, 13 . 

Uniformly Jtistributed: 11, 13. 

yrsample: 8, 14. 
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( Needed packages 6, 12 ) Used in section 5. 

{ Package boiler-plate 5 } Used in section 4. 

(Procedures and Tasks in probability 11, 13, 14) Used in section 5. 

( Specification of procedures visible from probability 8 ) Used in section 5. 

( Specification of types and variables visible from probability 7 ) Used in section 5. 
( Variables local to probability 10 ) Used in section 5. 
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Section Page 

Introduction 1 183 

Getopt Specification 7 184 

GetOpt Body 10 185 

System- dependent changes 21 189 

Index 23 190 
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1. Introduction. This package provides some primitive command-line processing typ- 
ical of Unix commands. 

2. This code is written using Donald Knuth’s WEB paradigm for literate programming. 
To compile and link the code in its present format you will need the Ada version of the 
WEB tool. 

It is available on-line via the world-wide-web at URL: 

http: / /white.nosc.mil/ ~evansjr /literate/ 

• P 

3. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
see the paper Literate Programming, by Donald Knuth in The Computer Journal, Vol 27, 
No. 2, 1984; or the book Weaving a Program: Literate Programming in WEB by Wayne 
Sewell, Van Nostrand Reinhold, 1989. Another good source of information is the Usenet 
group comp. programming. literate. It has information on new tools and Frequently Asked 
Questions (FAQs). 

4. The program consists of several packages that are declared right now; each of these 
packages and either the specification and the body of the packages are sent to a separate 
file. The main program itself is declared later. (Since the original AWEB package was 
written for Ada ’83, it does not properly format new Ada ’95 keywords protected and 
private . We remedy using the web format commands below. 

format protected = procedure 
format private = procedure 

5. As a way of explanation, each “Module” withing angle brackets (< >) is expanded 

somewhere further down in the document. Consider it a high-level PDL (Program De- 
scriptor Language). The trailing number you see within the brackets is where you can find 
this expansion. It is top-down in appearance, and in actual fact. 

6. All the modules follow the same, top-down format. I will group all the boiler-plate into 
one module, for the compiler, but you will see it with the packages, as they are described. 

( Package boiler-plate 7 ) 
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7. Getopt Specification. 

( Package boiler-plate 7 ) = 
output to file getopt . ads 

with Ustrings ; 
use Ustrings ; 
with TEXT. 10; 
use TEXT.IO; 

with Ada. Command-Line] 
use Ada. Command-Line] 
package getopt is 

( Specification of types and variables visible from getopt 8 ) 
( Specification of procedures visible from getopt 9 ) 
end getopt] 

output to file getopt. adb 

(Packages needed by getopt body 11 ) 
package body getopt is 

(Variables local to getopt 12) 

(Procedures and Tasks in getopt 13) 
end getopt] 

This code is used in section 6. 



8 . 

( Specification of types and variables visible from getopt 8 ) = 
This code is used in section 7. 



9. 

( Specification of procedures visible from getopt 9 ) = 

function option-present (option : in U string )ret urn boolean ; 
function name-present (Num : natural) return boolean; 
procedure get-option(option : in U string] par am : out Ustring ); 
procedure get-name(name : out Ustring; Num : in natural ); 
This code is used in section 7. 
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10. GetOpt Body. 



GETOPT BODY 



11 . 

( Packages needed by getopt body 11 ) = 

with Ada. Strings. Unbounded] Use Ada. Strings. Unbounded] with Ustrings] 
use Ustrings] 

This code is used in section 7. 



12 . 

(Variables local to getopt 12) = 
debug : boolean <— false] 

This code is used in section 7. 



13 . 

( Procedures and Tasks in getopt 13 ) = 

package natio is new integerAo (natural)] 
See also sections 14, 15, 16, and 19. 

This code is used in section 7. 



14 . 

( Procedures and Tasks in getopt 13 ) += 

function option-present [option : in U string Return boolean is 
knt : natural ; 
ispresent : boolean ; 
begin 

knt Argument-Count ; ispresent <— false] 
for i £ 1 . . knt loop 

if S(option) = Argument{i) then 
ispresent <— true] exit; 
end if; 
end loop; 
return ispresent] 
end option-present] 
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15. 

{ Procedures and Tasks in getopt 13 ) += 

procedure get-option (option : in U string \param : out Ustring) is 
knt : natural ; 
begin 

knt <— Argument-Count-, 
for i € 1 . . knt loop 

if S(option) — Argument(i) then 
param <— U (Argument (i + i)); 
end if; 
end loop; 
end get-option ; 



16 . 

( Procedures and Tasks in getopt 13 ) += 

function name-present (Num : natural)return boolean is 
knt , ic : natural ; 
i : natural < — 1; 
fknt : natural <— 0; 
ispresent : boolean ; 
begin 

ispresent <— false] 
if debug then 

put-line^' name_present>"); 
end if; 

knt Argument-Count ; 
while (i < knt) loop 

( If found option, skip it and its parameter 17 ) 

{ if not option, must be name, return true if right number 18 ) 
end loop; 
if debug then 

put^Argumentu"); natio .put(Num , 1); 
if ispresent then 

put-line ("ijis u present . "); 
else 

put-line (" u is u N0T u present . " ); 
end if; 
end if; 

return ispresent ; 
end name-present] 
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17 . 

( If found option, skip it and its parameter 17 ) = 
ic <— Index (TJ{ Argument (i)), 
if ic > 0 then 
i <- i + 2; 

end if; 
if debug then 

put-line ("Skipping u f irst u option . " 
end if; 

This code is used in sections 16 and 19. 



18 . 

(if not option, must be name, return true if right number 18 ) = 
if ic = 0 then 
fknt <— fknt + 1; 
if fknt = num then 
if debug then 

put-line ("Founduyourijinputuf ile u name ! " ); 
end if; 

ispresent <— true ; exit; 
end if; 

i «— i + 1; 

end if; 

This code is used in section 16. 



19 . 

( Procedures and Tasks in getopt 13 ) += 

procedure geLname(name : out Ustring ; Num : natural) is 
knt , ic : natural ; 
i : natural <— 1; 
fknt : natural <— 0; 
begin 

if debug then 

put-line ("get _name>" ); 
end if; 

knt <— Argument-Count ; 
while ( i < knt) loop 

(If found option, skip it and its parameter 17) 

(if not option, must be name, return if right number 20 ) 
end loop; 
end get-name ; 
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20 . 

{ if not option, must be name, return if right number 20 ) = 
if ic — 0 then 
fknt <— fknt + 1; 
if fknt = num then 
if debug then 

put-line ("Found u your u input u f ile u name ! " ); 
end if; 

name <— U (Argument(i)); exit; 
end if; 
i <— i + 1; 

end if; 

This code is used in section 19. 
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21. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

22. RCS Keywords. 

$RCSfile: getopt.aweb,v 
$ Revision: 1.1 
$Date: 1997/09/05 00:28:36 
$Author: evansjr 

$Id: getopt.aweb,v 1.1 1997/09/05 00:28:36 evansjr Exp evansjr 

$ Locker: evansjr 
$ State: Exp 
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23. Index. Here is a cross-reference table for the MAIN program. All modules in which 
an identifier is used are listed with that identifier, except that reserved words are indexed 
only when they appear in format definitions, and the appearances of identifiers in module 
names are not indexed. Underlined entries of subprograms and packages correspond to 
sections where this entity is specified, whereas entries in italic type correspond to the 
section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



Ada: 7, 11. 

Argument: 14-15, 17, 20. 

Argument-Count: 14-16, 19. 

boolean: 9, 12, 14, 16. 

Command-Line: 7. 

debug: 12, 16-20. 

false: 12, 14, 16. 

fknt: 16, 18-20. 

get-name: 9, 19. 

get-option: 9, 15. 

getopt: 7. 

getopt.adb: 7. 

getopt. ads: 7. 

i: 14, 15. 

ic: 16-20. 

Index: 17. 

integerjo: 13. 

ispresent: 14, 16, 18. 

lent: 14-16, 19. 

name: 9, 19-20. 

name-present: 9, 16. 

natio: 13, 16. 

natural: 9, 13-16, 19. 

num: 18, 20. 

Num: 9, 16, 19. 

option: 9, 14-15. 

option-present: 9, 14. 

param: 9, 15. 

private: 4. 

procedure: 4. 

protected: 4. 

put: 16. 

put-line: 16-20. 

Strings: 11. 

system dependencies: 21. 



TEXT.IO: 7. 

true: 14, 18. 

Unbounded: 11. 

Use: 11. 

Ustring: 9, 14-15, 19. 

U strings: 7, 11. 
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{ If found option, skip it and its parameter 17 ) Used in sections 16 and 19. 

{ Package boiler-plate 7 ) Used in section 6. 

{ Packages needed by getopt body 11 ) Used in section 7. 

( Procedures and Tasks in getopt 13, 14, 15, 16, 19 ) Used in section 7. 

{ Specification of procedures visible from getopt 9 ) Used in section 7. 
(Specification of types and variables visible from getopt 8) Used in section 7. 

( Variables local to getopt 12 ) Used in section 7. 

(if not option, must be name, return if right number 20 ) Used in section 19. 

(if not option, must be name, return true if right number 18 ) Used in section 16. 
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1. Introduction. Here is some code to test capabilities. It is written using Donald 
Knuth’s WEB format for literate programming. To compile and link the code in its present 
format you will need the Ada version of the WEB tool. 

It is available on-line via the world-wide-web at URL: 

http: / / white.nosc.mil/ ~evansjr /literate / 



2. WEB is a literate programming paradigm for C, Pascal or Ada, and other languages. 
This style of programming is called “Literate Programming.” For Further information 
get the book Literate Programming , by Donald Knuth, published by the Center for the 
Study of Language and Information, Stanford University, 1992. Another good source of 
information is the Usenet group comp. programming. literate. It has information on tools 
and answers to Frequently Asked Questions (FAQs). 

3. Who should use the WEB paradigm for programming? Well, not everybody. Here are 
a few paragraphs from Donald Knuth’s book that explains it best. 

4. Retrospect and Prospects. Enthusiastic reports about new computer languages, 
by the authors of those languages, are commonplace. Hence Pm well aware of the 
fact that my own experiences cannot be extrapolated too far. I also realize that, 
whenever I have encountered a problem with WEB, I’ve simply changed the system; 
other users of WEB cannot operate under the same ground rules. 

5. However, I believe that I have stumbled on a way of programming that produces 
better programs that are more portable and more easily understood and maintained 
than ever before; furthermore, the system seems to work with large programs as 
well as with small ones. I’m pleased that my work on typography, which began as 
an application of computers to another field, has come full circle and become an 
application of typography to the heart of computer science; I like to think of WEB as 
a neat “spinoff” of my research on TfeX. However, all of my experiences with this 
system have been highly colored by my own tastes, and only time will tell if a large 
number of other people will find WEB to be equally attractive and useful. 
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6. I made a conscious decision not to design a language that would be suitable for 
everybody. My goal was to provide a tool for system programmers, not for high 
school students or for hobbyists. I don’t have anything against high school students 
and hobbyists, but I don’t believe every computer language should attempt to offer 
all things to all people. A user of WEB needs to be good enough at computer science 
that he or she is comfortable dealing with several languates simultaneously. Since 
WEB combines T^X and Pascal with a few rules of its own, WEB programs can contain 
WEB syntax errors. T^X syntax errors, Pascal syntax errors, and algorithmic errors; 
in practice, all four types of errors occur, and a bit of sophistication is needed to 
sort out which is which. Computer specialists tend to be better at such things than 
other people. I have found that WEB programs can be debugged rapidly in spite of 
the profusion of languages, but I’m sure that many other intelligent people will find 
such a task difficult. 

7. In other words, WEB seems to be specifically for the peculiar breed of people who 
are called computer scientists. And I’m pretty sure that there are also a lot of 
computer scientists who will not enjoy using WEB; some of us are glad that tradi- 
tional programming languages have comparatively primitive capabilities for inserted 
comments, because such difficulties provide a good excuse for not documenting pro- 
grams well. Thus, WEB may be only for the subset of computer scientists who like 
to write and to explain what they are doing. My hope is that the ability to make 
explanations more natural will cause more programmers to discover the joys of lit- 
erate programming, because I believe it’s quite a pleasure to combine verbal and 
mathematical skills; but perhaps I’m hoping for too much. The fact that a least 
one paper has been written that is a syntactically correct ALGOL 68 program en- 
courages me to perservere in my hopes for the future. Perhaps we will even one day 
find Pulitzer prizes awarded to computer programs. 

8. Donald Knuth goes on to write about his hopes for the future of WEB programming. 

In an interview with Donald Knuth by Amazon Books on the release of a new edition of 

Volume 1 of The Art of Computer Programming (July 1, 1997) he was asked: 

Amazon.com: What do you see as the most 
interesting advance in programming since you 
published the first edition? 

Donald Knuth: It’s what I call literate 
programming, a technique for writing, documenting, 
and maintaining programs using a high-level 
language combined with a written language like 
English. This is discussed in my book Literate 
Programming. 
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9. In the same book, Literate Programming , there is a chapter called How to read a WEB. 
But it is actually quite straightforward. 

10. Very briefly, each “Module” within angle brackets (< >) is expanded somewhere 

further down in the document. The trailing number you see within the brackets is where 
you can find this expansion. This provides a type of PDL (program descriptor language) 
for your program and greatly aids modularity and readability. It is also a highly effective 
method of top-down programming. The first module here is expanded further down, and 
contains most of the structure in standard Ada packages. 

( Package boiler-plate 11 ) 
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11. Capabilities specification. 

(Package boiler-plate 11 ) = 

output to file capability .ads 

with TEXT.IO; 
use TEXT.IO; 
with tesLio.pkg ; 
use tesLio.pkg ; 
with g en erics eLp kg] 
with generic-map-pkg] 
with ustrings ; 
use ustrings ; 
package capability is 

( Specification of types and variables visible from capability 12 ) 

( Specification of procedures visible from capability 14 ) 
private 

( Specification of private types in capability 21 ) 
end capability ; 

output to file capability .adb 

with unchecked-deallocation ; 
with generic-map-pkg-, 

with Ada .Strings .Unbounded] Use Ada .Strings .Unbounded] with Ustrings] 

use ustrings] 

with Ada. Strings] 

use Ada. strings] 

with Ada .Characters .handling ] 

use Ada. Characters .handling] 

package body capability is 

( Variables and types local to capability 23 ) 

( Procedures and Tasks in capability 28 ) 
begin 

( Initialize capabilities 42 ) 
end capability] 

This code is used in section 10. 

12 . 

( Specification of types and variables visible from capability 12 ) = 
type deveLnum is private; 
type AString is access String] 
type ExpertiseLevel is (low , medium , high)] 

package cap-map is new generic-map-pkg(key =£■ Astring , result => ExpertiseLevel ); 
See also section 13. 

This code is used in section 11. 
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13 . 

( Specification of types and variables visible from capability 12 ) += 
badid : exception; 
pars ecapability error r exception; 



14 . 

{ Specification of procedures visible from capability 14 ) = 

procedure create-dev eloper (developer : in String-, yrid : out natural)-, 
See also sections 15, 16, 17, 18, 19, and 20. 

This code is used in section 11. 



15 . 

{ Specification of procedures visible from capability 14 ) += 

procedure add- capability (id r in natural ; yrcap : String; exp : ExpertiseLevel); 
procedure add- capability (yrid : in deveLnum; yrcap : cap-map .map); 
procedure add-capability (yrtask : in out cap-map .map; yrcap : String; 
exp : ExpertiseLevel); 



16 . 

{ Specification of procedures visible from capability 14 ) += 

procedure copy- capability (yrid : in natural ; yrcap rout cap-map .map); 



17 . 

{ Specification of procedures visible from capability 14 ) += 
procedure print- capabilities (id : natural); 
procedure print- capabilities (yrtask : cap.map .map); 
procedure print-capabilities (fd : file-type; yrtask : cap-map .map); 
procedure print-developers; 

function get-developer-name(id : natural) return ustring; 



18 . 

( Specification of procedures visible from capability 14 ) += 

function is- qualified (yrtask : cap-map .map; id : natural) return boolean; 



19 . 

{ Specification of procedures visible from capability 14 ) += 

procedure get- capability (str : in String;yrcap : out cap-map .map); 
procedure get-capability (fd : file-type ; yrcap rout cap-map .map); 
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20. 

(Specification of procedures visible from capability 14 } += 
procedure get-developers (infile : string ); 
function get-num-developers return natural ; 



21 . 

( Specification of private types in capability 21 ) = 
package capset is new genericset-pkg (Astring)] 
type capability is new capset. set] 
max-developers : constant natural <— 20; 
type deveLnum is new natural range 1 . . max-developers ; 

This code is used in section 11. 
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22. Capability Body. 



CAPABILITY BODY 



23. 

( Variables and types local to capability 23 } = 
debug : boolean <— false] 
debugB : boolean <— false ; 
gstring : U string ; 

See also sections 24, 25, 26, and 27. 

This code is used in section 11. 



24. Maintain a global set of capabilities; 

( Variables and types local to capability 23 ) += 
globalcaps : cap-set .set] 
totaLdevelopers : natural *— 0; 

25. Creating new step. 

(Variables and types local to capability 23) += 
function "+"(str : string )ret urn Astring is 
begin 

return new string' {str)] 
end "+"; 



26. 

( Variables and types local to capability 23 ) += 

MAXCAPS : constant natural «— 30; 

type cap.num is new natural range 1 .. MAXCAPS ; 

type cap^array is array (cap^num) of Astring ; 

capabilities : cap-array <— (+"Ada", +"Database", +"XWindows", +"Graphics", 
+ "Unix", others => null); 
mycaps : cap-set .set] 
totaLcaps : cap.num <— 5; 



27. 

(Variables and types local to capability 23 ) += 
type cap-rec is 
record 

inuse : boolean *— false] 
name : Astring] 
cmap : cap„map .map ; 
end record; 

type developer-array is array ( deveLnum ) of cap_rec] 
developers : developer-array] 
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28. 

( Procedures and Tasks in capability 28 ) = 

procedure create-developer (developer : in String-, yrid : out natural ) is 
knt : deveLnum ; 
tmpcap : cap^map .map ; 
begin 

( Fetch an unused developer 29 ) 

{ Assign capabilities to him 30 ) 

{ Create capability out of his name 31 ) 
end create-developer ; 

See also sections 33, 34, 35, 41, 44, 45, 46, 47, 48, 49, 50, 52, 62, 63, and 69. 

This code is used in section 11. 



29 . 

( Fetch an unused developer 29 ) = 
knt +— 1; 

while developers (knt). inuse loop 
knt <— knt + 1; 
end loop; 

developers (knt). inuse +— true ; totaLdevelopers <— totaLdev elopers + 1; 
yrid <— natural (knt)-, 

This code is used in section 28. 



30 . 

( Assign capabilities to him 30 ) = 

©{for i G 1 . . totaLcaps loop 

cap-map .bind (capabilities (i), low , developers (knt). cmap)-, 

end loop; 

©} 

This code is used in section 28. 



31 . 

( Create capability out of his name 31 ) = 

totaLcaps +— totaLcaps +1; capabilities (totaLcaps) < h developer-, 

cap-map .bind (capabilities (totaLcaps ), high , developers (knt). cmap)-, 
capset .add (capabilities (totaLcaps ), globalcaps ); 
developers (knt). name <— capabilities (totaLcaps)-, 

( Add this capability to all the other developers 32 ) 
if debug then 
print_developers ; 
end if; 

This code is used in section 28. 
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32 . 

( Add this capability to all the other developers 32 ) = 

®{for i € deveLnum loop 

if [developers [i).inuse) A (i ^ id) then 
if debug2 then 

put ("Addingucapabilityu"); put [developer)] put(" u to u developer L |"); 
put [developers [i). name . all); putJine [ " . u "); 

end if; 

cap.map .bind [capabilities [totaLcaps ), low , developers [i).cmap ); 

end if; 
end loop; 

This code is used in section 31. 



33 . 

(Procedures and Tasks in capability 28) +~ 

procedure add. capability (yrtask : in out cap.map .map ; yrcap : String ; 
exp : ExpertiseLevel) is 
acap : A string] 
is.member : boolean] 
knt : cap.num] 
begin 

( First convert to upper-case 37 ) ( See if already in capabilities array 38 ) 
if -i is-member then 

totaLcaps totaLcaps + 1; capabilities (totaLcaps) <— acap] 
cap. set .add (capabilities (totaLcaps ), globalcaps ); knt <— totaLcaps] 

end if; 

cap.map .bind (capabilities (knt), exp , yrtask ); 
end add. capability ; 
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34 . 

( Procedures and Tasks in capability 28 ) += 

procedure addLcapability (yrid : in dev eLnum ; y reap : cap.map .map) is 
expl : ExpertiseLevel ; 
id : natural ; 
begin 

id <— natural (yrid)\ 

for i 6 1 . . totaLcaps loop 

if cap.map. member ( capabilities (i), yrcap) then 
expl 4 — cap.map. f etch (y reap , capabilities^))] 
add. capability (id, capabilities (z).all, expl ); 
end if; 
end loop; 
end add. capability ; 

35 . 

( Procedures and Tasks in capability 28 } += 

procedure add. capability (id : in natural ; yrcap : String] exp : ExpertiseLevel) is 
acap : A string] 
is.member : boolean] 
knt : cap.num] 
yrid : deveLnum] 

package enum.io is new enumerationAo (ExpertiseLevel)] 
begin 

yrid <— deveLnum(id)] 
if -i developers (yrid). inuse then 
raise badid] 
end if; 

( First convert to upper-case 37 )( See if already in capabilities array 38 ) 
if -> is.member then 

totaLcaps 4 — totaLcaps + 1 ; capabilities (totaLcaps ) 4 — acap] 
cap.set .add (capabilities (totaLcaps ), globalcaps ); ( Add to all developers 40 ) 
else 

(Update capabilities of this developer 39) 

end if; 

end add.capability ] 
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36 . 

{ Convert to upper-case 36 ) = 
declare 

tstr : string <— yrcap ; 
name : ustring\ 

begin 

name «— get-developer-name(natural(yrid)); 
if tstr ^ S(name) then 

for j £ 1 . . yrcap' length loop 
tstr(j) <— to-upper(tstr(j )); 
end loop; 
end if; 

acap < \-tstr\ 

end; 



37 . 

( First convert to upper-case 37 ) = 
declare 

tstr : string <— yrcap ; 
begin 

for j G 1 .. yrcap' length loop 
tstr(j) <— to-upper(tstr(j))] 
end loop; 
acap i \-tstr] 

end; 

This code is used in sections 33 and 35. 



38 . 

( See if already in capabilities array 38 ) = 
is-member *— false ; 
for i 6 1 .. totaLcaps loop 

if (capabilities (i). all = acap .all) then 

acap «— capabilities (i); knt *— i\ is.member *— true ; exit; 
end if; 
end loop; 

This code is used in sections 33 and 35. 
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39 . 

{ Update capabilities of this developer 39 ) = 
if debug then 

put ("Updating u capabilities u of u developer : u " ); 

put (S(get.developer.name (natural (yrid)))); put ("uu"); put (capabilities (fcnt). all); 
put (" u =>|j"); enum.io .put(exp); new.line ; 

end if; 

cap.map .bind (capabilities (knt), exp , developers ( yrid).cmap ); 

This code is used in section 35. 



40. 

( Add to all developers 40 ) = 
for i £ deveLnum loop 
if (i / yrid) then 

if (developers (i). inuse) then 

cap.map .bind (capabilities (totaLcaps ), low , developers (i).cmap ); 

end if; 
else 

cap.map .bind (capabilities (totaLcaps ), exp , developers (i).cmap ); 

end if; 
end loop; 

This code is used in section 35. 

41. Copy everything but developer’s name. 

{ Procedures and Tasks in capability 28 ) += 

procedure copy. capability (yrid : in natural ; yrcap : out cap.map .map) is 
expl : ExpertiseLevel ; 
yr : deveLnum; 
namel ,name2 lustring ; 
begin 

yr «— deveLnum(yrid); 
for i £ 1 . . totaLcaps loop 

if cap.map. member (capabilities (i), developers (yr).cmap) then 

namel <— U (capabilities (i). all); name2 «— get-developer.name(yrid); 
if namel ^ name2 then 

expl <— cap.map ,fetch(developers (yr).cmap , capabilities (t)); 
add. capability (yrcap , capabilities (z).all, expl ); 
end if; 
end if; 
end loop; 
end copy.capability ; 
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42 . 

( Initialize capabilities 42 ) = 
cap-set .empty (globalcaps ); 
for i G 1 . . totaLcaps loop 
( Convert to uppercase 43 ) 

capabilities (z) « \-S(gstring ); cap^set .add ( capabilities (i), globalcaps ); 

end loop; 

This code is used in section 11. 



43 . 

{ Convert to uppercase 43 ) = 
declare 

tstr : String *— capabilities (t).all; 
chr : Character ; 
begin 

for j G 1 .. tstr' length loop 

chr <— tstr(j ); tstr(j) «— tO-upper(chr ); 
end loop; 
gstring *— U(tstr ); 
end; 

This code is used in section 42. 
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44. 

( Procedures and Tasks in capability 28 ) += 

function is- qualified (yrtask : cap-map .map ; id : natural) return boolean is 
expl , exp2 : Expertise Lev el; 
answer : boolean <— true; 
yrid : deveLnum; 
begin 

yrid <— deveLnum(id); 
for i £ 1 . . totaLcaps loop 

if cap-map .member (capabilii i),y v ) then 
expl <— cap-map .fetch(yrtask , capabilities (i)); 
if cap-map .member (capabilities (i), developers (yrid). cmap) then 
exp2 <— cap.map .fetch (developers (yrid). cmap , capabilities (i)); 
else 

exp2 <— low; 

end if; 

if exp2 < expl then 
answer *— false; exit; 
end if; 
end if; 
end loop; 
return answer; 
end is-qualified; 
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45 . 

( Procedures and Tasks in capability 28 ) += 

procedure print-capabilities (yrtask : cap.map .map) is 
exp : Expertiselevel ; 

package exp-io is new enumeration-io (Expertiselevel)] 
use exp-io ; 
kntl ,knt2 : cap-num] 
begin 

kntl <— 1; knt2 <— 1; 
for i (E 1 . • totaLcaps loop 

if cap-map .member (capabilities (i), yrtask) then 
kntl <— kntl + 1; 
end if; 
end loop; 
puf("{ M ); 

for i € 1 • • totaLcaps loop 

if cap-map .member (capabilities (i), yrtask ) then 

put(capabilities (i).all); pui(":u")j ex P *— cap-map ,fetch(yrtask , capabilities (i))] 
put(exp)] knt2 <— knt2 +1; 
if knt2 < kntl then 
put (", u "); 
end if; 
end if; 
end loop; 
pui("}”); 

end print-capabilities ; 
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46. 

{ Procedures and Tasks in capability 28 ) += 

procedure print-capabilities (fd : file-type ] yrtask : cap map .map ) is 
exp : Expertiselevel ; 

package expAo is new enumerationAo (Expertiselevel)] 
use expAo] 
kntl ,knt2 : cap-num ; 
begin 

kntl <— 1; knt2 <— 1; 
for i 6 1 .. totaLcaps loop 

if cap-map .member (capabilities (i), yrtask ) then 
kntl <— kntl + 1; 
end if; 
end loop; 
put(fd, "{")■, 

for i G 1 . . totaLcaps loop 

if cap-map .member ( capabilities (i), yrtask ) then 
put(fd , capabilities (i).all); put(fd : u ")- 

exp <— cap-map .fetch(yrtask , capabilities (i)); put(fd , exp)] knt2 <— knt2 + 1; 
if knt2 < kntl then 
put(fd,", u "); 
end if; 
end if; 
end loop; 
put (fd,"}")] 
end print- capabilities ; 
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47 . 

{ Procedures and Tasks in capability 28 ) += 
procedure print- capabilities [id : natural ) is 
exp : Expertiselevel ; 

package expAo is new enumerationAo (Expertiselevel)] 
use expAo ; 
kntl , knt2 : cap.num] 
yrid : deveLnum ; 
begin 

yrid deveLnum (id); kntl <— 1; knt2 <— 1; 
for i 6 1 .. totaLcaps loop 

if cap-map. member (capabilities (i), developers (yrid). cmap) then 
kntl <— kntl + 1; 

end if; 
end loop; 

for i 6 1 .. totaLcaps loop 

if cap-map .member (capabilities (i), developers ( yrid ).cmap ) then 
put (capabilities (i).all); put(" : u "); 

exp <— cap.map ,fetch(developers (yrid). cmap , capabilities (i)); put(exp)] 
knt2 *— knt2 -f 1; 
if knt2 < kntl then 
puf(", u "); 
end if; 
end if; 
end loop; 
pu<("}"); 

end print-capabilities ; 



48 . 

( Procedures and Tasks in capability 28 ) += 
procedure print-developers is 
name : ustring] 
begin 

for i G 1 . . totaLdevelopers loop 

name <— get-developer-name(i); put(S(name))\ put( n > u ")] print-capabilities (i)] 
newAine] 

end loop; 

end print-developers] 
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49. 

{ Procedures and Tasks in capability 28 ) += 

function get-developer-name (id : natural ) return ustring is 
grid : deveLnum ; 
begin 

grid <— deveLnum(id ); return U (developers (grid). name. all); 
end get-developer-name ; 



50. 

( Procedures and Tasks in capability 28 ) += 

procedure get-capability (fd : file-type ; yrcap rout cap-map .map) is 
{ Variables local to f get-capability 51 ) 
begin 
chr 

while chr ^ loop 
get-immediate (fd , chr)-, 
end loop; 
j *— 1; newstr(j) <— 
while chr ^ '}•' loop 

j <— j + 1; get-immediate(fd, chr)-, newstr(j) *— chr ; 

end loop; 
declare 

newstr2 : String( 1 . . j); 
begin 

for k € 1 .. j loop 

new$tr2(k) <— newstr(k); 
end loop; 
tstr •*— U(newstr2 ); 
end; 

if debug then 

put ("get _capabilitiesu (file) > u calling u get_capabilities u (string) u with" ); 
pu<( ,, u string L |= L )' , ); put (S (tstr)); new-line; 
end if; 

get-capability (S(tstr), yrcap ); 
end get-capability ; 



51. 

( Variables local to fget-capability 51 ) = 
j : positive ; 
chr : character; 
newstr : String( 1 . . 80); 
tstr : ustring; 

This code is used in section 50 . 
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( Procedures and Tasks in capability 28 ) += 

procedure get.capability (str : in String ; yrcap : out cap.map .map) is (Variables local 
to get-capability 53 ) 
begin 

tstr <— U (str)] indl <— index [tstr, ind2 <— index[tstr, ")•"); 
tstr <— U (slice (tstr , indl ,ind2))\ 
if debug2 then 

put("Parsing u stringu'"); put[S(tstr )); put-line[" ' . "); 
end if; 

tstr <— tail(tstr,length(tstr)— indl ); finished <— false; while -> finished loop 
(Get capability name pairs 54} end loop; end g et- capability ; 



53. 

(Variables local to get- cap ability 53) = 
tstr : ustring ; 
indl : natural ; 
finished : boolean ; 

See also sections 56, 58, and 60. 

This code is used in section 52. 



54. 

( Get capability name pairs 54 ) = 

( Check if finished 55 ) 
if -> finished then 

(Get capability 57) (Get ExpertiseLevel 59) (Add new capability to map 61 ) 

end if; 

This code is used in section 52. 



55. Each name pair is separated by a colon It it is not there, then we are finished. 
(Provided we didn’t look past the brace 

( Check if finished 55 ) = 

ind2 <— index (tstr ind3 <— index (tstr, ")•"); 
if ( ind2 = 0) V ( ind2 > ind3) then 
finished <— true ; 

end if; 

if ind3 = 0 then 

raise parsecapabilityerror ; 

end if; 

This code is used in section 54. 
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56. 

(Variables local to get. capability 53) += 
ind2 , indS : natural ; 

57. 

( Get capability 57 ) = 

indl <— index.non.blank(tstr)] tstr2 *— U (slice (tstr, indl ,ind2 — 1)); 
if debug2 then 

pu<("tstr2 u = u "); put(S(tstr2))] new.line ; 
end if; 

tstr <— tail (tstr , length(tstr) — ind2 ); 
if debug2 then 

put ("tstrij=u"); put(S(tstr )); new.line ; 
end if; 

This code is used in section 54. 



58. 

( Variables local to get. capability 53 ) += 
tstr 2 : ustring ; 

59. 

(Get ExpertiseLevel 59) = 

indl <— index(tstr, " , "); ind2 <— index (tstr 
if indl = 0 then 

indl <— ind2\ finished <— true ; 

end if; 

tstr3 <— U (slice (tstr ,1, indl —1)); 
if debug2 then 

pu/("tstr3 L ,= L ,"); put (S(tstr3 )); new.line ; 
end if; 

enum-io .get(S(tstr3), exp , Last)] tstr <— tail(tstr, length (tstr) — indl)] 
if debug2 then 

put("tstr u = u "); put (S(tstr )); new.line] 
end if; 

This code is used in section 54. 



60. 

(Variables local to get.capability 53) += 
tstr 3 : ustring] 
exp : ExpertiseLevel ; 

package enum.io is new enumeration.io (ExpertiseLevel)] 
Last : positive ; 
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61 . 

( Add new capability to map 61 ) = 
add- capability (yrcap , S(tstr2 ), exp)] 

This code is used in section 54. 

62 . 

{ Procedures and Tasks in capability 28 ) += 

function get-num-developers return natural is 
begin 

return totaLdevelopers ; 
end get-num.-developers ; 



63 . 

( Procedures and Tasks in capability 28 ) += 
procedure get-developers (infile : string) is 
( Variables local to get-developer 65 ) 

begin 

(Open file 64) (Read in developers 66) 
end get-developers ; 



64 . 

( Open file 64 ) = 

open ( data. file , in- file , infile)] 
This code is used in section 63. 



65 . 

(Variables local to get-developer 65) = 
data-file : file-type ; 

See also section 68. 

This code is used in section 63. 



66 , 

( Read in developers 66 ) = 

while -i end- of- file (data-file) loop 

( Get developer’s name and capabilities 67 ) 

end loop; 

This code is used in section 63. 
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67 . 

( Get developer’s name and capabilities 67 ) = 

g eLline (data. file, newstr, Last); tstr U (newstr)] ind2 *— index (tstr 

indl *— indez-non-blank (tstr)] name <— U (slice (tstr , indl ,ind2 —1)); 
tstr *— tail(tstr ,length(tstr) — ind2 + 1); 
declare 

yrcap : cap_map .map ; 
begin 

geLcapability (S(tstr), yrcap)] create-developer(S(name), dummy)] 
adcLcapability (deveLnum(dummy), yrcap ); 

end; 

This code is used in section 66. 



68 . 

(Variables local to get-developer 65 ) += 
Last : natural ; 
newstr : String^ 1 .. 132); 
indl , ind2 : natural ; 
name , tstr : ustring ; 
dummy : natural ; 



69. 

( Procedures and Tasks in capability 28 ) += 
procedure put-developers (outfile : string ) is 
data. file : file-type ; 
begin 

create [data- file , out-file , outfile ); 
end put-developers ; 
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70. Test capabilities driver. Here, finally, is the boilerplate. The Ada WEB tool 
atangle reads this and knows to write out two separate files, the specification and the 
body. (The Ada WEB tool aweave will write out just one documentation file.) 

output to file testcap.adb 

pragma suppress (alLchecks)] 

with ustrings ; 

use ustrings ; 

with texLio ; 

use text-io ; 

with capability ; 

use capability ; 

procedure testcap is (Instantiate generic packages 71 )( Variables local to testcap 73) 
begin 

( Test if items are in set 72 ) 

( Create a task map and see if any developers qualify 76 } 

( Print out items in set 74 ) 

( Check qualifications 75 ) 

( Try reading in some capabilities 78 ) 
end testcap ; 



71. 

(Instantiate generic packages 71 ) = 

package nat_io is new integer_io [natural)] 
use nat-io ; 

This code is used in section 70. 



72. 

( Test if items are in set 72 ) = 

create- dev eloper ( M Bill u Gates M , myid)] addLcapability ( myid , "Breathing", High)] 
create.dev eloper ( M Scott u McNealy n , myid2)] addLcapability (myid2 , "Java", high)] 
create-developer ("Bill u Joy M , myid3 ); addLcapability (myid3 , "Unix", high)] 
addLcapability (myid3 , "Systems u progrannning" , high)] 

This code is used in section 70. 



73. 

( Variables local to testcap 73 ) ~ 
myid , myid2 , myidS : natural] 
See also sections 77 and 79. 

This code is used in section 70. 
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74. 

( Print out items in set 74 ) = 

new-line ; print_ capabilities (myid); new-line ; print- capabilities (myidS)] new-line ; 
print-capabilities (myid3 ); new-line-, prints capabilities (taskl ); new-line ; 

This code is used in section 70. 



75. 

{ Check qualifications 75 ) = 

if is-qualified (taskl ,myid) then 

put-line ("BilluGatesuisuqualif ied. " ); 
end if; 

if is- qualified (taskl , my id2) then 

put-line ( "Scott u McNeally u is u qualif ied . " 
end if; 

if is-qualified (taskl ,myid3) then 

put-line ("BilluJoy u is u qiialif ied . " ); 
end if; 

This code is used in section 70. 



76. 

{ Create a task map and see if any developers qualify 76 ) = 
add- capability (taskl , "Unix", medium,)', 

This code is used in section 70. 

77. 

( Variables local to testcap 73 ) += 
taskl : cap-map .map ; 



78. 

( Try reading in some capabilities 78 } = 

create_deve/oper("John u Evans", myidj ); get- capability (testcapstr ,task2 ); 
print-capabilities (task2 ); new-line ; 

put-line ("Here u is u Bill u Joy 's u capabilities u again>" ); print-capabilities (myid3 ); 
puL/me("Here u are u all u the u developer's u capabilities u again. "); 
print-developers ; get-developers ("developers .txt" ); print-developers ; 

This code is used in section 70. 



79. 

( Variables local to testcap 73 ) 
testcapstr : String <— 

" {Unix : high , Ada : high , Xwindows : medium , Sy s t ems u Pr ogr amming : medium} 11 ; 
task2 : cap_map .map ; 
myid4 : natural ; 
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80. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make TESTCAP work at a particular instal- 
lation. It is usually best to design your change file so that all changes to previous mod- 
ules preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

81. RCS Keywords. 

$RCSfile: capability. aweb,v 
$Revision: 1.1 
$Date: 1997/09/05 00:31:42 
$ Author: evansjr 

$Id: capability.aweb,v 1.1 1997/09/05 00:31:42 evansjr Exp evansjr 

$Locker: evansjr 
$State: Exp 
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82. Index. Here is a cross-reference table for the TESTCAP program. All modules in 
which an identifier is used are listed with that identifier, except that reserved words are 
indexed only when they appear in format definitions, and the appearances of identifiers 
in module names are not indexed. Underlined entries of subprograms and packages corre- 
spond to sections where this entity is specified, whereas entries in italic type correspond 
to the section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



acap: 33, 35-38. 

Ada: 11. 

add: 31, 33, 35, 42. 

add- capability : lji, 33, 34, 35, 41, 61, 

67, 72, 76. " 
alLchecks: 70. 

answer: 44. 

Astring: 12, 21, 25-27, 33, 35. 

A String: 12. 

badid : 13, 35. 

bind: 30-33, 39-40. 

boolean: 18, 23, 27, 33, 35, 44, 53. 

cap _ array : 26. 

cap.map: 12, 15-19, 27-28, 30-34, 39-41, 

44-47, 50, 52, 67, 77, 79. 
cap-num: 26, 33, 35, 45-47. 

cap -rec: 27 . 

cap-set: 21, 24, 26, 31, 33, 35, 42. 

capabilities : 26, 30-35, 38-47. 

capability: 11, 21, 70. 

capability. adb : 11. 

capability .ads : 11. 

Character: 43. 

character: 51. 

Characters: 11. 

chr: 43, 50-51. 

cmap: 27,30-32,39-41,44,47. 

copy- capability : 16, 41 . 

create: 69. 

create- developer : 14, 28, 67, 72, 78. 

data-file: 64-67, 69. 

debug: 23, 31, 39, 50. 

debug2 : 23,32,52,57,59. 
deveLnum: 12, 15, 21, 27-28, 32, 34-35, 

40-41, 44, 47, 49, 67. 



developer: 14, 28, 31-32. 

developer-array: 27. 

developers: 27, 29-32, 35, 39-41, 44, 

47, 49. 

dummy: 67-68. 

empty: 42. 

en<Lof-file: 66. 

enum-io: 35, 39, 59, 60. 

enumeration-io: 35, 45-47, 60. 

exp: 15,33,35,39-40,45-47,59-61. 

exp-io: 45, 46, 47 . 

ExpertiseLevel: 12, 15, 33-35, 41, 44, 60. 

Expertiselevel: 45-47. 

expl : 34, 41, 44. 

exp2 : 44. 

false: 23, 27, 38, 44, 52. 

fd: 17, 19, 46, 50. 

fetch: 34, 41, 44-47. 
file-type: 17, 19, 46, 50, 65, 69. 

finished: 52-55, 59. 

generic-map-pkg: 11-12. 

genericset-pkg : 11, 21. 

get: 59. 

get-capability : 19, 50, 52, 67, 78. 

get-developer-name: 17, 36, 39, 41, 

48, 49- 

get-developers: 20, 63, 78. 

get-immediate: 50. 

get-line: 67. 

get-num-dev elopers : 20, 62 . 

globalcaps : 24, 31, 33, 35, 42. 

gstring: 23, 42-43. 

handling: 11. 

High: 72. 

high: 12, 31, 72. 
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i: 30, 32, 34, 38, 40, 41, 42, 44, 45, 
46, 47, 48- 

id: 15, 17-18, 32, 34-35, 44, 47, 49. 

in-file : 64. 

index: 52, 55, 59, 67. 

index-non-blank : 57, 67. 

indl : 52-53, 57, 59, 67-68. 

ind2 : 52, 55-57, 59, 67-68. 

ind3 : 55-56. 

infile: 20, 63-64. 

integer-io: 71. 

inuse: 27, 29, 32, 35, 40. 

is-member: 33, 35, 38. 

is-qualified: 18, 44, 75. 

j: 36, 37, 43- 

k: 50. 

key: 12. 

knt: 28-31, 33, 35, 38-39. 

kntl : 45-47. 

knt2 : 45-47. 

Last : 59-60, 67-68. 

length: 36-37, 43, 52, 57, 59, 67. 

low: 12, 30, 32, 40, 44. 

map: 15-19, 27-28, 33-34, 41, 44-46, 

50, 52, 67, 77, 79. 
max- dev elopers: 21. 

MAX CAPS: 26. 
medium: 12, 76. 

member: 34, 41, 44-47. 

mycaps : 26. 

myid: 72-75. 

myid2 : 72-75. 

myid3 : 72-75, 78. 

myid4 : 78-79. 

name: 27, 31-32, 36, 48-49, 67-68. 

namel : 41. 

name2: 41. 

nat-io : 71. 

natural: 14-18, 20-21, 24, 26, 28-29, 

34-36, 39, 41, 44, 47, 49, 53, 56, 
62, 68, 71, 73, 79. 
new-line : 39, 48, 50, 57, 59, 74, 78. 

newstr: 67-68. 



newstr: 50-51. 

newstr 2: 50. 

open: 64. 

out-file : 69. 

outfile: 69. 

pars ecapability error : 13,55. 

positive: 51, 60. 

print-capabilities : 17, 45, 46, 47, 48, 

74, 78. 

print-developers: 17, 31, 48, 78. 

put: 32,39,45-48,50,52,57,59. 

put-developers : 69. 

put-line: 32, 52, 75, 78. 

result: 12. 

set: 21, 24, 26. 

slice: 52, 57, 59, 67. 

str: 19, 25, 52. 

String: 12, 14-15, 19, 28, 33, 35, 43, 

50-52, 68, 79. 

string: 20, 25, 36-37, 63, 69. 

strings : 11. 

Strings: 11. 

suppress : 70. 

system dependencies: 80. 

tail: 52, 57, 59, 67. 

taskl : 74-77. 

task2: 78-79. 

test-io-pkg: 11. 

testcap: 70 . 

testcap.adb: 70. 

testcap str: 78-79. 

TEXT.IO: 11. 

text-io: 70. 

tmpcap : 28. 

to-upper: 36-37, 43. 

totaLcaps : 26, 30-35, 38, 40-42, 44-47. 

total-developers: 24, 29, 48, 62. 

true: 29, 38, 44, 55, 59. 

tstr: 36-37, 43, 50-53, 55, 57, 59, 67-68. 

tstr2: 57-58, 61. 

tstr3: 59-60. 

Unbounded: 11. 

unchecked-deallocation: 11. 
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Use : 11 . 

ustring : 17, 36, 41, 48-49, 51, 53, 58, 

60, 68. 

Ustring: 23. 

U strings: 11 . 

ustrings: 11, 70. 

yr: 41. 

yrcap: 15-16, 19, 33-37, 41, 50, 52, 

61, 67. 

yrid : 14-16, 28-29, 34-36, 39-41, 44, 
47, 49. 

yrtask: 15, 17-18, 33, 44-46. 
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( Add new capability to map 61 ) Used in section 54. 

( Add this capability to all the other developers 32 ) Used in section 31. 

( Add to all developers 40 ) Used in section 35. 

( Assign capabilities to him 30 ) Used in section 28. 

( Check if finished 55 ) Used in section 54. 

{ Check qualifications 75 ) Used in section 70. 

( Convert to upper-case 36 ) 

( Convert to uppercase 43 ) Used in section 42. 

( Create a task map and see if any developers qualify 76 ) Used in section 70. 

( Create capability out of his name 31 ) Used in section 28. 

( Fetch an unused developer 29 ) Used in section 28. 

(First convert to upper-case 37) Used in sections 33 and 35. 

( Get capability 57 ) Used in section 54. 

( Get developer’s name and capabilities 67 ) Used in section 66. 

( Get Expertise Lev el 59 ) Used in section 54. 

( Get capability name pairs 54 ) Used in section 52. 

(Initialize capabilities 42) Used in section 11. 

( Instantiate generic packages 71 ) Used in section 70. 

( Open file 64) Used in section 63. 

( Package boiler-plate 11 ) Used in section 10. 

( Print out items in set 74 ) Used in section 70. 

( Procedures and Tasks in capability 28, 33, 34, 35, 41, 44, 45, 46, 47, 48, 49, 50, 52, 62, 63, 69 ) 
Used in section 11. 

( Read in developers 66 ) Used in section 63. 

( See if already in capabilities array 38 ) Used in sections 33 and 35. 

( Specification of private types in capability 21 ) Used in section 11. 

( Specification of procedures visible from capability 14, 15, 16, 17, 18, 19, 20 ) 

Used in section 11. 



(Specification of types and variables visible from capability 12, 13) Used in section 11. 
( Test if items are in set 72 ) Used in section 70. 

( Try reading in some capabilities 78 ) Used in section 70. 

(Update capabilities of this developer 39) Used in section 35. 

( Variables and types local to capability 23, 24, 25, 26, 27 ) Used in section 11. 

(Variables local to testcap 73, 77, 79 ) Used in section 70. 

(Variables local to f get-capability 51 ) Used in section 50. 

(Variables local to get-capability 53, 56, 58, 60 ) Used in section 52. 

(Variables local to get-developer 65, 68) Used in section 63. 
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1. Introduction. This routine generates a number of tasks for which a valid schedule 
exists. The output of this routine is fed into the scheduling algorithm to test its perfor- 
mance. This particular version uses the capability model described in my thesis. 

2. This is the main routine that starts everything, 
output to file task_generator .adb 

pragma Unsuppress (all-checks); 

with CALENDAR; 

use CALENDAR; 

with text-io ; 

use text-io ; 

{ Needed packages 10 ) 
procedure task-generator is 

package nat-io is new integer-io (natural)-, 
use nat-io; 

package flLio is new floaLio (float)] 
use flt-io ; 

package booLio is new enumeration-io (boolean); 
use booLio ; 

( Variables local to task-generator 6 ) 

( Functions local to task-generator 33 ) 
begin 

{ Get input parameters 4 ) 
declare 

{ Allocate a static array to hold tasks for schedule 12 ) 
begin 

( Compute earliest available time (EAT) in resource matrix 15) 

R <— laxity ; 

for i £ 1 . . tasks loop 

( Generate another task 16 ) 
end loop; 
if do-alternate then 

( Convert to calendar time 35 ) 
end if; 

( Print out results 34 ) 
end; 

end task-generator ; 
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3. This routine takes two input parameters. (1) “-tasks” the number of tasks to 
generate; and (2) “-laxity” the laxity, or tightness, parameter. This is formally defined 
as 

Td — T e ,t + Tp 

where Td is the deadline, T ea t is the earliest start-time, and Tp is the processing time. It 
is computed apriori by the task-generator . 

T D = (l + R)* SC 

where R is an input parameter, and SC is the shortest completion time. 

4. The input values are read in using the routines in package getopt. I read in the number 
of tasks to compute, the “laxity” of the schedule, and a “seed” for the random number 
generator. 

{ Get input parameters 4 ) = 
tasks *— 10; 

if option-present(U(" -tasks")) then 

get-option ( U ("-tasks" ), param ); get(S(param ), tasks , Last ); 
end if; 
laxity <— 0.0; 

if option-present(U(" -laxity")) then 

get-option(U(" -laxity"), param)] get(S(param), laxity , Last); 
end if; 
seed *— 68069; 

if option-present (U(" -seed")) then 

get-option (17 ( "-seed" ), param ); get(S(param ), seed , Last ); 
end if; 

( Get NRaD option 5 ) 

( Get developer file 7 ) 

( Get developers 8 ) 

This code is used in section 2. 



5. 

( Get NRaD option 5 ) = 

if option-present (17("-nrad")) then 

get-option (U(" -nrad"), param ); yet (5 {param), nrad , Last)] 
else 

nrad <— true ; 

end if; 

See also section 45. 

This code is used in section 4. 
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6 . 

(Variables local to task-generator 6) = 
tasks : natural ; 
laxity : float ; 

Last : positive ; 
param : U string; 
seed : natural ; 
nrad : boolean ; 

See also sections 9, 13, 18, 19, 22, 26, 29, 30, 32, 37, 41, 44, and 46. 
This code is used in section 2. 

7 . 

( Get developer file 7 ) = 
if name-present ( 1) then 
geLname (dev file , 1); 
else 

raise nofilename ; 

end if; 

This code is used in section 4. 



8 . 

( Get developers 8 ) = 

get-developers (S(devfile)); num-developers *— geLnum- dev elopers', 
This code is used in section 4. 



9 . 

( Variables local to task-generator 6 ) += 
nofilename : exception; 
devfile : ustring ; 
num-developers : natural', 

10 . We need some more packages to read in the parameters. Specifically the package 

getopt written by this student; and the package Ustrings — used for manipulating “un- 
bounded” strings. 

( Needed packages 10 ) = 
with Ustrings ; 
use Ustrings ; 
with GetOpt ; 
use GetOpt ; 

See also sections 11, 14, 24, and 39. 

This code is used in section 2. 
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11 . We also add the following package to enhance the capability model the scheduler 
(and task-generator) can use. 

( Needed packages 10 ) += 
with capability, 
use capability, 



12 . 

( Allocate a static array to hold tasks for schedule 12 ) = 
sched : array (1 .. tasks ) of StepRecord ; 
newsched : array (1 .. tasks ) of NewStepRecord; 
mysample : booLarray ( 1 .. tasks); 

See also section 31. 

This code is used in section 2. 



13 . 

( Variables local to task- generator 6 ) += 
type New Step Record is 
record 

CalDuration : Duration; 
CalStartTime : Time; 
CalDeadLine : Time; 

end record; 



14 . 

( Needed packages 10 ) += 
with genericseLpkg; 
with SchedPrims ; 
use SchedPrims ; 



15 . 

(Compute earliest available time (EAT) in resource matrix 15) = 
MATRIX-MIN (EAT , Min, COL); 

This code is used in sections 2 and 28. 
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16 . 

( Generate another task 16 ) = 

( Compute duration of task T_p 17 ) 

( Compute predecessors 25 ) 

{ Compute earliest start time 20 ) 

{ Compute deadline T-D 21 ) 

( Compute priority P 23 ) 
sched(i).StepJD <— z; sched(i). Deadline <— T_£>; sched[i). Priority <— P] 
sched(i).EstimatedDuration <— T_p; (Assign expertise level 27) 

( Update resource matrix 28 ) 

This code is used in section 2. 

17 . The duration varies in length between MIN-D and MAX-D. The duration will not 

go over the maximum task deadline ( MTD ). 

( Compute duration of task T_p 17 ) = 

T_p <— uniform(MIN-D , MAX.D)] {duration} 

This code is used in section 16. 

18 . Minimum task duration. 

(Variables local to task-generator 6) += 

Min-D : natural <— 2; 

19 . Maximum task duration. 

(Variables local to task- generator 6) += 

Max-D : natural <—10; 



20 . 

( Compute earliest start time 20 ) = 
for j € 1 . . (i — 1) loop 

if natset .member (j , sched(i). predecessors) then 

if Sched(j). deadline > sched(i).EarliestStartTime then 
sched(i).EarliestStartTime <— Sched(j). Deadline] 
if debug then 

pu<("Modified u Sched. ("); put(i, 1); put ('Outouheu"); 
put(sched(i).EarliestStartTime,l ); puLline ( " . u "); 
end if; 
end if; 
end if; 
end loop; 

This code is used in section 16. 
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21. The deadline (T-D) is a function of the duration and the least value of a resource 
in the resource matrix. 

{ Compute deadline T-D 21 ) = 

TT <— integer (float (T-p) * (1.0 + laxity))] 
if debug then 

put("01d u deadline u is u "); put(sched(i). Deadline , 1); put ( " .u")i 
end if; 

if ached (i).EarliestStartTime > EAT (COL) then 
T-D <— TT + ached (i).EarlieatStartTime] 
else 

T-D <— TT + EAT(C .); 
end if; 
if debug then 

put("NewL|deadline u is u "); put(T-D, 1); put-line (". u ")] 
end if; 

This code is used in section 16. 



22 . 

(Variables local to task.generator 6) += 
debug : boolean false] 
debug2 : boolean <— false] 

23. A random value. 

( Compute priority P 23 ) = 

P uniform(4, 10); 

This code is used in section 16. 

24. 

( Needed packages 10 ) += 
with Probability] 
use Probability ] 
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25. I choose to select M out of N tasks as predecessors. M has an upper limit of 
Max-Predecessors and N is the number of previous tasks assigned. If the number of 
previous tasks scheduler is less than Max_Predecessors then the minimum is selected then 
the upper limit is the number of previous tasks scheduled. M is selected randomly. 

( Compute predecessors 25 ) = 
if do-predecessor then 

if i < Max-Predecessors then 
ptasks <— (z — 1); 
else 

ptasks <— Max-Predecessors ; 

end if; 

nsamp <— uniform(0, ptasks); 
if i > 1 then 

sample (nsamp ,i — 1 ,mysample); 
for j € 1 . . (i — 1) loop 
if my sample (j) then 

tl <— natset .size(Sched(i). Predecessors); 
t2 <— naLset. size (Sched(j). Successors); 

if (tl < Max-Predecessors ) A (t2 < Max-Predecessors ) then 

natset.add(j , Sched(i). Predecessors ); naLset. add (z, Sched(j). Successors ); 

end if; 
end if; 
end loop; 
end if; 
end if; 

This code is used in section 16. 



26 . 

( Variables local to task-generator 6 ) += 
Max-Predecessors : constant natural <— 0; 
ptasks, nsamp : natural; 
tl ,t2 : natural; 



27. 

( Assign expertise level 27 ) = 
declare 

tmpcap : cap.map. map; 
begin 

copy-capability (COL, sched(i).ExpLevel); 
end; 

This code is used in section 16. 
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28 . 

( Update resource matrix 28 ) = 
if debug then 

put("Before u Update: u "); put("EAT("); put(COL,l); put(")u = u")'> 
put (EAT (COL), 1); put-line(" . u "); 

end if; 

EAT (COL) 4 - T-D\ 
if debug then 

put ("After u Update: LJ "); put("EAT("); puf(COL,l); put(")u = u")> 
put (EAT (COL), 1); put-line(" . u "); 
end if; 

{ Compute earliest available time (EAT) in resource matrix 15 ) 

This code is used in section 16. 



29. 

(Variables local to task-generator 6) += 

R : float 4— 0.7; 

R3 : natural 4— 3; {laxity} 

UU : natural 4— 1; 

U1 : natural 4— 3; {seed} 

U2 : natural 4— 1; 

type RESOURCE-MATRIX is array (POSITIVE range <>) of natural-, 
do-predecessor : BOOLEAN 4— true-, 

30. Max task deadline. 

( Variables local to task-generator 6 ) += 

MTD : natural 4— 70000; 

31. The way this is defined, it “hard-codes” the maximum number of designers per leve 
to ‘2.’ (Must be in concordance with the maximum number of designers defined above.) 

( Allocate a static array to hold tasks for schedule 12 ) += 

EAT : RESOURCE-MATRIX (1 .. num-developers) 4— (others => 0); 

32. 

(Variables local to task- generator 6) += 

P, T-D , T-p ,R1 , R2 , C : natural ; 

Min : natural 4 — 0; 

COL : natural 4— 1; 

COUNT : natural 4— 0; 

TT : integer-, 
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33. This finds the smallest value in the resource matrix and returns the index of the 
minimum value. 

( Functions local to task-generator 33 ) = 

procedure MATRIX.MIN (MATRIX : in RESOURCE-MATRIX ; MIN : out 
natural; Kl : out natural) is 
Mini : natural <— MATRIX (1); 
begin 
Kl «- 1; 

for j 6 2.. MATRIX 1 Length 1 °p 
if Mini > MATRIX (j) the 
Mini «- MATRIX (j); Kl *- j; 
end if; 
end loop; 

MIN «- Mini ; 
end MATRIX-MIN; 

This code is used in section 2. 

34. Procedure Putset is declared in package schedprims . 

(Print out results 34) = 
for i € 1 . . tasks loop 
if -i do- alternate then 

put(sched (i). Deadline, 4); put(sched (i). Priority , 4); 

put(sched (i).EstimatedDuration , 5); put(sched {i).EarliestStartTime , 5); 

{ earliest start time } 

put(" u "); putset (Sched(i). Predecessors); puLset(Sched(i). Successors); 

put(" u "); print-capabilities (Sched (i).ExpLevel); neui-line; 
else 

print-date (newsched ( i).CalDeadline ); put(sched (z). Priority , 5); 
put(sched {i).EstimatedDuration , 5); put (" u "); 

print-date (newsched (i).CalStartTime); ptd(" u "); putset(Sched (i). Predecessors ); 
puf(" u "); putset(Sched(i). Successors); put(" u "); 
print- capabilities ( Sched{i).ExpLevel ); new-line; 

end if; 
end loop; 

This code is used in section 2. 
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35. 

{ Convert to calendar time 35 ) = 

{ Get start date 36 ) 

Start-Time *— Current-Time ; 
for i E 1 . . tasks loop 

{ Convert Start Time to Calendar Time 43 ) 

{ Convert Task Duration to Duration type 42 ) 

{ Convert Deadline to Calendar Time 47 ) 
end loop; 

This code is used in section 2. 

36. For now “hard-code” a date (July 1st, 1997). 

( Get start date 36 ) = 

Current-Time *— Time.of (1997, 7, 3); (Find first work-day 38) iidebug2 then (Print 
out first work day 40 ) end if; 

This code is used in section 35. 



37. 

(Variables local to task. generator 6) += 

Current-Time, Start-Time : Time ; 
do-alternate : boolean *— false-, 

38. 

( Find first work-day 38 ) = 

while (-i/s WorkD ay [Current- Time , nrad)) loop 

Current-Time <— Current-time + Day-Duration 1 Last-, 
end loop; 

This code is used in section 36. 

39. Package to find federal off-days till year 2099 (barring acts of God, or Congress). 

( Needed packages 10 ) += 
with calyr ; 
use calyr ; 

40. 

( Print out first work day 40 ) = 

S plit( Current- Time , Year , Month, Day , Seconds ); put ( M The u f irst u work u day u is u M ); 
put (Month, 3); put("/")\ put(Day ,3); put("/")-, put(Year, 4); put-line ( ,l . ,l ); 

This code is used in section 36. 
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41. 

{ Variables local to task-generator 6 ) += 
Year : Year-number ; 

Month : Month-number] 

Day : Day-Number] 

Seconds : Day-Duration] 



42. 

{ Convert Task Duration to Duration type 42 ) = 

newsched(i).CalDuration < — ConvertHoursto Duration (sched (i) .EstimatedDuration ); 

This code is used in section 35. 

43. 

{ Convert Start Time to Calendar Time 43 ) = 

TotalTime <— ConvertHoursToDuration(Sched ( i).EarliestStartTime ); 
newsched(i).CalStartTime <— DurationTo Calendar Time (Start-Time, dailyhours , 
TotalTime , NRad)] 
if debug2 then 

testduration <— CalendarTimetoDuration(Start-Time, dailyhours, 
newsched (i).CalStartTime , NRaD ); 
testhours *— ConvertDurationToHours (testduration)] 
if sched (i).EarliestStartTime ^ testhours then 

pu<("ERROR u in u CalendeurTimetoWorkHours M ); new-line ; 
put("CalendarTime u returned u "); put (testhours)] 

put^uanduitushouldLjhaveLjretumedu" ); put (sched (i).EarliestStartTime)] 
put (" ."); put (" (NRad)) u = u")i put(NRaD)] new-line] 

put("The u StartLjTimeLjis u " ); print-date (Start-Time)] 
put(" . u The u TotalTime u is u " ); put (float ( TotalTime )); 
pu<("In u hours u th.at u is u "); put(ConvertDurationtoEours(TotalTime )); 
put(")"); puf(".uu"); new-line] 
end if; 
end if; 

This code is used in section 35. 

44. 

(Variables local to task-generator 6) += 
testduration : Duration ; 
testhours : natural ; 
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45 . 

( Get NRaD option 5 ) += 
for day (E Mon . . Thu loop 
if nrad then 

dailyhours (Day) *— 9.0 * Seconds Per Hour ; 
else 

dailyhours (Day) *— 8.0* SecondsPerHour ; 

end if; 
end loop; 

dailyhours (Fri) <— 8.0 * SecondsPerHour ; 



46. 

( Variables local to task-generator 6 ) += 
dailyhours : Workhours; 

SecondsPerHour : constant Duration <— 3600.0; 
TotalTime : duration ; 



47. 

( Convert Deadline to Calendar Time 47 ) = 

TotalTime <— ConvertHoursToDuration(Sched(i). Deadline)] 
newsched(i).CalDeadline <— DurationTo Calendar Time (Starts Time , dailyhours , 
TotalTime , NRad)] 

This code is used in section 35. 
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48. System-dependent changes. This module should be replaced, if necessary, by 
changes to the program that are necessary to make MAIN work at a particular installation. 
It is usually best to design your change file so that all changes to previous modules 
preserve the module numbering; then everybody’s version will be consistent with the 
printed program. More extensive changes, which introduce new modules, can be inserted 
here; then only the index itself will get a new module number. 

49. RCS Keywords. 

$RCSfile: task-generator. aweb,v 
$Revision: 1.3 
$Date: 1997/09/05 00:35:25 
$Author: evansjr 

$Id: task_generator.aweb,v 1.3 1997/09/05 00:35:25 evansjr Exp evansjr 

$Locker: evansjr 
$State: Exp 
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50. Index. Here is a cross-reference table for the MAIN program. All modules in which 
an identifier is used are fisted with that identifier, except that reserved words are indexed 
only when they appear in format definitions, and the appearances of identifiers in module 
names are not indexed. Underlined entries of subprograms and packages correspond to 
sections where this entity is specified, whereas entries in italic type correspond to the 
section where the entity’s body is stated. For any other identifier underlined entries 
correspond to where the identifier was declared. Error messages and a few other things 
like “ASCII code” are indexed here too. 



add : 25. 

alLchecks: 2. 

booLarray: 12. 

booLio : 2. 

boolean: 2, 6, 22, 37. 

BOOLEAN: 29. 

CalDeadline: 34, 47. 

CalDeadLine : 13. 

CalDuration: 13, 42. 

CALENDAR: 2. 

CalendarTimetoDuration : 43. 

CalStartTime: 13, 34, 43. 

calyr: 39. 

cap.map : 27. 

capability : 11. 

COL: 15, 21, 27-28, 32. 

ConvertDurationtoHours: 43. 

ConvertDurationToHours: 43. 

ConvertHours To Duration: 43, 47. 

ConvertHourstoDuration: 42. 

copy, capability : 27. 

COUNT: 32. 

Current-Time: 35-38, 40. 

Current-time: 38. 

dailyhours : 43, 45-47. 
day : 45. 

Day: 40-41, 45. 

Day-Duration: 38, 41. 

Day-Number: 41. 

Deadline: 16, 20-21, 34, 47. 

deadline: 20. 

debug: 20-22, 28. 

debug2 : 22, 36, 43. 

devfile: 7-9. 

do-alternate: 2, 34, 37. 



do-predecessor: 25, 29. 

duration : 46. 

Duration: 13, 44, 46. 

DurationToCalendarTime: 43,47. 

EarliestStartTime: 20-21, 34, 43. 

EAT: 15, 21, 28, 31. 

enumeration-io : 2. 

EstimatedDuration: 16, 34, 42. 

Exp Level: 27, 34. 

false: 22, 37. 

float: 2, 6, 21, 29, 43. 

float-io: 2. 

flt-io : 2. 

Fri: 45. 

genericset-pkg: 14. 

get: 4-5. 

get-developers : 8. 

get-name: 7. 

get-num-developers : 8. 

get-option: 4-5. 

getopt: 4, 10. 

GetOpt: 10. 

i: 2, 34, 35- 

integer: 21, 32. 

integerAo : 2. 

IsWorkDay: 38. 

j: 20, 25, 33- 
K1 : 33. 

Last: 4-6, 38. 

laxity: 2, 4, 6, 21. 

Length: 33. 

map: 27. 

MATRIX: 33. 

MATRIX.MIN: 15, 33- 
MAX-D: 17. 
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Max-D : 19. 

Max-Predecessors : 25-26. 

member: 20. 

MIN: 33. 

Min: 15, 32. 

MIN.D: 17. 

Min-D: 18. 

Mini : 33. 

Mon: 45. 

Month: 40-41. 

Month-number: 41. 

MTD: 17, 30. 

mysample: 12, 25. 

name-present: 7. 

naLio : 2. 

natset: 20, 25. 

natural: 2, 6, 9, 18-19, 26, 29-30, 

32-33, 44. 
new-line: 34, 43. 

newsched: 12, 34, 42-43, 47. 

NewStepRecord : 12, 13 . 

nofilename: 7, 9. 

nrad: 5-6, 38, 45. 

NRad: 43, 47. 

NRaD: 43. 
nsamp: 25-26. 

num-developers : 8-9, 31. 

option-present: 4-5. 

param: 4-6. 

positive : 6. 

POSITIVE: 29. 

Predecessors : 25, 34. 

predecessors : 20. 

print-capabilities : 34. 

print-date: 34, 43. 

Priority: 16, 34. 

Probability: 24. 

ptasks: 25-26. 

put: 20-21, 28, 34, 40, 43. 
put-line: 20-21, 28, 40. 

putset: 34. 

Putset: 34. 

RESOURCE-MATRIX: 29,31,33. 



Rl: 


32. 


R2: 


32. 


R3 : 


29. 



sample : 25. 

Sched: 20,25,34,43,47. 
sched: 12,16,20-21,27,34,42-43. 

SchedPrims : 14. 

schedprims : 34. 

Seconds: 40-41. 

SecondsPerHour: 45-46. 

seed: 4, 6. 

size: 25. 

Split: 40. 

Start-Time: 35, 37, 43, 47. 

StepID: 16. 

StepRecord : 12. 

Successors : 25, 34. 

system dependencies: 48. 

T-D: 16, 21, 28, 32. 

T-p: 16-17, 21, 32. 

task-generator: 2, 3, 11. 

task_generator .adb : 2. 

tasks: 2, 4, 6, 12, 34-35. 

testduration: 43-44. 

testhours : 43-44. 

texLio: 2. 

Thu: 45. 

Time: 13, 37. 

Time-of : 36. 

tmpcap : 27. 

TotalTime: 43, 46-47. 

true: 5, 29. 

TT: 21, 32. 

tl : 25-26. 

t2 : 25-26. 

uniform: 17, 23, 25. 

Unsuppress : 2. 

ustring : 9. 

Ustring: 6. 

Ustring s: 10. 

UU: 29. 

U1 : 29. 

U2 : 29. 
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Workhours : 46 . 

Year : 40 - 41 . 

Year-number: 41 . 
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( Allocate a static array to hold tasks for schedule 12, 31 ) Used in section 2. 

( Assign expertise level 27 ) Used in section 16. 

( Compute deadline T-D 21 ) Used in section 16. 

( Compute duration of task 17 ) Used in section 16. 

( Compute earliest available time (EAT) in resource matrix 15 ) Used in sections 2 and 28. 
( Compute earliest start time 20 ) Used in section 16. 

( Compute predecessors 25 ) Used in section 16. 

( Compute priority P 23 ) Used in section 16. 

( Convert Deadline to Calendar Time 47 ) Used in section 35. 

( Convert Start Time to Calendar Time 43 ) Used in section 35. 

( Convert Task Duration to Duration type 42 ) Used in section 35. 

( Convert to calendar time 35 ) Used in section 2. 

( Find first work-day 38 ) Used in section 36. 

( Functions local to task^generator 33 ) Used in section 2. 

( Generate another task 16 ) Used in section 2. 

( Get NRaD option 5, 45 ) Used in section 4. 

( Get developer file 7 ) Used in section 4. 

( Get developers 8 ) Used in section 4. 

( Get input parameters 4 ) Used in section 2. 

( Get start date 36 ) Used in section 35. 

( Needed packages 10, 11, 14, 24, 39 ) Used in section 2. 

( Print out first work day 40 ) Used in section 36. 

( Print out results 34 ) Used in section 2. 

( Update resource matrix 28 ) Used in section 16. 

(Variables local to task^generator 6, 9, 13, 18, 19, 22, 26, 29, 30, 32, 37, 41, 44, 46 ) 

Used in section 2. 
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